Ir ao conteúdo
  • Cadastre-se

Guilherme Stoduto

Membro Júnior
  • Posts

    14
  • Cadastrado em

  • Última visita

Reputação

1
  1. Bom dia Pessoal! Necessito da ajuda de vocês para transcrever um código VBA para a linguagem do Apps Script do Google Sheets. Preciso criar uma "banco de dados" usando o google sheets que é o único ao meu ver que tem a possibilidade de executar macros de forma online. Abaixo o código VBA: Sub InserirDados() Application.ScreenUpdating = False Dim CodMaterial As String Dim Descricao As String Dim QuantidadeSolicitada As Long Dim Chapa As String Dim Supervisor As String Dim CodPessoa As Long Dim Segmento As String Dim LocalidadeDestino As String Dim CentroCusto As String Dim Retirada As String Dim Data As String Dim DC As String Dim UltimaLinha As Long Dim I As Integer Dim Linha As Long Dim Coluna As Integer Dim LinhaRT As Long Dim Solicitacao As Double Dim DataNova As String Coluna = 1 Linha = 6 Solicitacao = WorksheetFunction.Max(Sheets("RELATÓRIO").Range("N:N")) + 1 LinhaRT = Sheets("RELATÓRIO").Range("A" & Rows.Count).End(xlUp).Row + 1 UltimaLinha = Sheets("REQUISIÇÃO").Range("A" & Rows.Count).End(xlUp).Row For I = 6 To UltimaLinha Chapa = Sheets("REQUISIÇÃO").Range("A2") Supervisor = Sheets("REQUISIÇÃO").Range("B2") CodPessoa = Sheets("REQUISIÇÃO").Range("D2") LocalidadeDestino = Sheets("REQUISIÇÃO").Range("A4") Segmento = Sheets("REQUISIÇÃO").Range("E2") CentroCusto = Sheets("REQUISIÇÃO").Range("B4") Retirada = Sheets("REQUISIÇÃO").Range("D4") Data = Sheets("REQUISIÇÃO").Range("E4") DC = Sheets("REQUISIÇÃO").Range("A" & I) CodMaterial = Sheets("REQUISIÇÃO").Range("B" & I) Descricao = Sheets("REQUISIÇÃO").Range("C" & I) QuantidadeSolicitada = Sheets("REQUISIÇÃO").Range("E" & I) DataNova = Replace(Data, "/", "") Sheets("RELATÓRIO").Activate Cells(LinhaRT, 2) = CodMaterial Cells(LinhaRT, 3) = Descricao Cells(LinhaRT, 4) = QuantidadeSolicitada Cells(LinhaRT, 5) = Chapa Cells(LinhaRT, 6) = Supervisor Cells(LinhaRT, 7) = CodPessoa Cells(LinhaRT, 8) = Segmento Cells(LinhaRT, 9) = LocalidadeDestino Cells(LinhaRT, 10) = CentroCusto Cells(LinhaRT, 11) = Retirada Cells(LinhaRT, 12) = Data Cells(LinhaRT, 13) = DC Cells(LinhaRT, 14) = Solicitacao Cells(LinhaRT, 1) = "R" & Solicitacao & DataNova LinhaRT = LinhaRT + 1 Next I Sheets("REQUISIÇÃO").Activate Range("A2,B2:C2,D2,E2,E4,D4,B4:C4,A4").Select Selection.ClearContents Range("A6:E6").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents MsgBox "CÓDIGO RESERVA: " & "R" & Solicitacao & DataNova Application.ScreenUpdating = True End Sub
  2. @Midori Código resolvido, tive que mudar algumas linhas, mas no fim, funcionou o que estava querendo. Agradeço imensamente o suporte! Segue abaixo o código final: Sub InserirDados() Application.ScreenUpdating = False Dim CodMaterial As String Dim Descricao As String Dim QuantidadeSolicitada As Long Dim Chapa As String Dim Supervisor As String Dim CodPessoa As Long Dim Segmento As String Dim LocalidadeDestino As String Dim CentroCusto As String Dim Retirada As String Dim Data As String Dim DC As String Dim UltimaLinha As Integer Dim I As Integer Dim Linha As Long Dim Coluna As Integer Dim LinhaRM As Long Coluna = 1 Linha = 6 LinhaRM = Sheets("RM").Range("B" & Rows.Count).End(xlUp).Row + 1 UltimaLinha = Sheets("REQUISIÇÃO").Range("A" & Rows.Count).End(xlUp).Row For I = 6 To UltimaLinha Chapa = Sheets("REQUISIÇÃO").Range("A2") Supervisor = Sheets("REQUISIÇÃO").Range("B2") CodPessoa = Sheets("REQUISIÇÃO").Range("D2") LocalidadeDestino = Sheets("REQUISIÇÃO").Range("A4") Segmento = Sheets("REQUISIÇÃO").Range("E2") CentroCusto = Sheets("REQUISIÇÃO").Range("B4") Retirada = Sheets("REQUISIÇÃO").Range("D4") Data = Sheets("REQUISIÇÃO").Range("E4") CodMaterial = Sheets("REQUISIÇÃO").Range("B" & I) Descricao = Sheets("REQUISIÇÃO").Range("C" & I) QuantidadeSolicitada = Sheets("REQUISIÇÃO").Range("E" & I) DC = Sheets("REQUISIÇÃO").Range("A" & I) Sheets("RM").Activate Cells(LinhaRM, 2) = CodMaterial Cells(LinhaRM, 3) = Descricao Cells(LinhaRM, 4) = QuantidadeSolicitada Cells(LinhaRM, 5) = Chapa Cells(LinhaRM, 6) = Supervisor Cells(LinhaRM, 7) = CodPessoa Cells(LinhaRM, 8) = Segmento Cells(LinhaRM, 9) = LocalidadeDestino Cells(LinhaRM, 10) = CentroCusto Cells(LinhaRM, 11) = Retirada Cells(LinhaRM, 12) = Data Cells(LinhaRM, 13) = DC LinhaRM = LinhaRM + 1 Next I Application.ScreenUpdating = True End Sub
  3. @Midori Perfeito! Funcionou. porém só preenche as primeiras linhas, se for gerar novamente ele vai substituir os dados e não inserir novos dados a partir da ultima linha preenchida. Preciso que continue preenchendo o relatório.
  4. @Midori copiei o código que você mencionou mas não funcionou, não deu erro porém mas preencheu nada. Testei outro método, usando =célula para retornar o valor e depois usar o VBA para preencher o relatório. código abaixo: Sub InserirDados() Application.ScreenUpdating = False Dim CodMaterial As String Dim Descricao As String Dim QuantidadeSolicitada As String Dim Chapa As String Dim Supervisor As String Dim CodPessoa As String Dim Segmento As String Dim LocalidadeDestino As String Dim CentroCusto As String Dim Retirada As String Dim Data As String Dim DC As String Dim UltimaLinhaRE As Integer Dim UltimaLinhaRM As Integer Dim I As Integer Dim U As Integer UltimaLinhaRE = Sheets("REQUISIÇÃO").Range("G" & Rows.Count).End(xlUp).Row UltimaLinhaRM = Sheets("RM").Range("B" & Rows.Count).End(xlUp).Row For I = 2 To UltimaLinhaRE Chapa = Sheets("REQUISIÇÃO").Range("G" & I) Supervisor = Sheets("REQUISIÇÃO").Range("H" & I) CodPessoa = Sheets("REQUISIÇÃO").Range("I" & I) Segmento = Sheets("REQUISIÇÃO").Range("J" & I) LocalidadeDestino = Sheets("REQUISIÇÃO").Range("K" & I) CentroCusto = Sheets("REQUISIÇÃO").Range("L" & I) Retirada = Sheets("REQUISIÇÃO").Range("M" & I) Data = Sheets("REQUISIÇÃO").Range("N" & I) DC = Sheets("REQUISIÇÃO").Range("O" & I) CodMaterial = Sheets("REQUISIÇÃO").Range("P" & I) Descricao = Sheets("REQUISIÇÃO").Range("Q" & I) QuantidadeSolicitada = Sheets("REQUISIÇÃO").Range("R" & I) Next I For U = 2 To UltimaLinhaRM Sheets("RM").Activate Sheets("RM").Range("B" & U) = CodMaterial Sheets("RM").Range("C" & U) = Descricao Sheets("RM").Range("D" & U) = QuantidadeSolicitada Sheets("RM").Range("E" & U) = Chapa Sheets("RM").Range("F" & U) = Supervisor Sheets("RM").Range("G" & U) = CodPessoa Sheets("RM").Range("H" & U) = Segmento Sheets("RM").Range("I" & U) = LocalidadeDestino Sheets("RM").Range("J" & U) = CentroCusto Sheets("RM").Range("K" & U) = Retirada Sheets("RM").Range("L" & U) = Data Sheets("RM").Range("M" & U) = DC Next U Application.ScreenUpdating = True End Sub Achei esse método mais "fácil", porém continua não dando erro e preenchendo nada, porém estou com o feeling que esta falando alguma linha nesse código para funcionar corretamente, só não consigo encontrar.
  5. @Midori Estou usando o seguinte código: Sub InserirDados() Application.ScreenUpdating = False Dim CodMaterial As String Dim Descricao As String Dim QuantidadeSolicitada As Long Dim SaldoEstoque As Long Dim Chapa As String Dim Supervisor As String Dim CodPessoa As Long Dim Segmento As String Dim LocalidadeDestino As String Dim CentroCusto As String Dim Retirada As String Dim Data As String Dim DC As String Dim UltimaLinha As Integer Dim I As Integer Dim Linha As Integer Dim Coluna As Integer Coluna = 1 Linha = 6 UltimaLinha = Sheets("REQUISIÇÃO").Range("A" & Rows.Count).End(xlUp).Row For I = 6 To UltimaLinha Chapa = Sheets("REQUISIÇÃO").Range("A2") Supervisor = Sheets("REQUISIÇÃO").Range("B2") CodPessoa = Sheets("REQUISIÇÃO").Range("D2") Localidade = Sheets("REQUISIÇÃO").Range("A4") Segmento = Sheets("REQUISIÇÃO").Range("E2") CentroCusto = Sheets("REQUISIÇÃO").Range("B4") Retirada = Sheets("REQUISIÇÃO").Range("D4") Data = Sheets("REQUISIÇÃO").Range("E4") CodMaterial = Sheets("REQUISIÇÃO").Range("B" & I) Descricao = Sheets("REQUISIÇÃO").Range("C" & I) QuantidadeSolicitada = Sheets("REQUISIÇÃO").Range("E" & I) SaldoEstoque = Sheets("REQUISIÇÃO").Range("D" & I) DC = Sheets("REQUISIÇÃO").Range("A" & I) Sheets("RM").Activate Sheets("RM").Range("B2") = CodMaterial Sheets("RM").Range("C2") = Descricao Sheets("RM").Range("D2") = QuantidadeSolicitada Sheets("RM").Range("E2") = SaldoEstoque Sheets("RM").Range("F2") = Chapa Sheets("RM").Range("G2") = Supervisor Sheets("RM").Range("H2") = CodPessoa Sheets("RM").Range("I2") = Segmento Sheets("RM").Range("J2") = LocalidadeDestino Sheets("RM").Range("K2") = CentroCusto Sheets("RM").Range("L2") = Retirada Sheets("RM").Range("M2") = Data Sheets("RM").Range("N2") = DC Next I End Sub A minha duvida é como eu devo fazer o loop para ele preencher os dados de codmaterial, descrição, saldoestoque e quantidadesolicitada e preencher com a mesma informação das demais. Nesse meu código ele só retorna a primeira linha, só o primeiro material, o restante ele não preenche.
  6. Bom dia Pessoal! Necessito da ajuda de vocês, estou quebrando a cabeça a alguns dias com esse problema. Preciso mandar dados de uma planilha para outra, a segunda planilha eu estaria montando um relatório de todos os dados da primeira. Segue exemplo: Primeira tabela de registro Segunda tabela onde quero mandar as informações para gerar um relatório.RELATÓRIO.xlsx Já estou a dias quebrando a cabeça e procurando formas de desenvolver esse problema, só consegui preencher a primeira linha usando VBA e nada mais. Se puderem me ajudar, agradeço imensamente! Estou anexando os dois arquivos para ajudar. REQUISIÇÃO.xlsx RELATÓRIO.xlsx
  7. @Midori Obrigado! No caso eu só precisei levar a ult_linha1 para o inicio do loop, e não deixar no começo do Sub.
  8. @Midori a variável ult_linha1, seria para encontrar a ultima linha da Sheet Movimentações. onde eu teria que usar ela também pra selecionar todas as informações da Sheet Entrada de Mercadorias? Estou usando a variável U_L para encontrar a ultima linha da Sheet Entrada de Mercadorias...
  9. Boa tarde! Estou com a seguinte duvida: Não consigo levar as informações completas de cada célula da sheet1 para sheet2. Abaixo as Sheets. Sheet1 (Entrada de Materiais): Sheet2 (Movimentações): Ao clicar no botão de Registrar Entrada, o mesmo deveria enviar as informações das 3 linhas para sheet2, porém só leva a ultima linha. Abaixo o código do botão Registrar Entrada. Sub Registrar_Entrada() ult_linha1 = Worksheets("Movimentações").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row Dim data As String Dim classificacao As String Dim Codigo As String Dim descricao As String Dim fornecedor As String Dim Nota As String Dim pedido As String Dim quantidade As String Dim status As String U_L = Sheets("Entrada de Materiais").Range("A" & Rows.Count).End(xlUp).Row For I = 7 To U_L data = Worksheets("Entrada de Materiais").Range("A" & I) classificacao = Worksheets("Entrada de Materiais").Range("B" & I) Codigo = Worksheets("Entrada de Materiais").Range("C" & I) descricao = Worksheets("Entrada de Materiais").Range("D" & I) fornecedor = Worksheets("Entrada de Materiais").Range("G" & I) Nota = Worksheets("Entrada de Materiais").Range("H" & I) pedido = Worksheets("Entrada de Materiais").Range("I" & I) quantidade = Worksheets("Entrada de Materiais").Range("J" & I) status = Worksheets("Entrada de Materiais").Range("K" & I) Worksheets("Movimentações").Activate Worksheets("Movimentações").Range("A" & ult_linha1) = data Worksheets("Movimentações").Range("B" & ult_linha1) = status Worksheets("Movimentações").Range("C" & ult_linha1) = classificacao Worksheets("Movimentações").Range("D" & ult_linha1) = Codigo Worksheets("Movimentações").Range("E" & ult_linha1) = descricao Worksheets("Movimentações").Range("F" & ult_linha1) = quantidade Worksheets("Movimentações").Range("G" & ult_linha1) = fornecedor Worksheets("Movimentações").Range("H" & ult_linha1) = Nota Worksheets("Movimentações").Range("I" & ult_linha1) = pedido 'limpar conteudo completo 'Range("A7:C100,G7:K100").Select 'Selection.ClearContents 'Range("A7").Select Next I End Sub Obrigado!
  10. Preciso que seja multiplicado a textbox(codigo) com conforme a quantidade informada no textbox(quantidade). Exemplo: tenho o textbox(codigo) 123 e informo no textbox(quantidade) que existe 2 unidades desse codigo, quando salvar, preciso que na planinha esteja 123, 123 e não 123 * 2.
  11. Bom dia! Tenho 2 textboxs uma informando codigo e a outra informando a quantidade, preciso que ao enviar o textbox(codigo) para planilha, preciso que seja multiplicado pelo valor da textbox(quantidade). Estou com esse codigo abaixo: Private Sub botao_salvar_Click() Workbooks("Separação_de_Materiais.xlsm").Worksheets("INICIO").Activate ult_linha = Workbooks("Separação_de_Materiais.xlsm").Worksheets("INICIO").Range("N5").End(xlUp).Row Range("N" & ult_linha).Select Do If ActiveCell.Value <> Empty Then ActiveCell.Offset(1, 0).Select End If Loop Until ActiveCell.Value = Empty ActiveCell.Value = TextBox_codigo.Text ActiveCell.Value = TextBox_quantidade.Value MsgBox ("Material inserido com sucesso!") TextBox_codigo.Text = Empty TextBox_quantidade.Text = Empty End Sub
  12. Boa noite! Senhores, Sou novo no vba e ultimamente estava programando procurando códigos na internet e testava com minhas ideias, porém estou criando um projeto para empresa onde eu trabalho e acabei ficando preso no final do meu projeto. Estou precisando de um suporte em 2 etapas: solicito seus e-mails para publicar as 2 planilhas que estão co-linkadas, pois não estou conseguindo anexar as mesmas aqui. Preciso de suporte especificamente no form NOVO que esta na Planilha SEPARAÇÂO DE MATERIAIS. 1ª: Exportando dados das textbox do botão NOVO para Planilha a partir da célula N5. porém o mesmo precisa ser feito uma multiplicação de 2 textboxs... 2ª: Todo o código desse form esta co-linkado a outra planilha (Banco de Dados) e só funciona se a mesma estiver aberta, gostaria que esse form funcionasse sem ter essa planilha de Banco de Dados aberta. Posso passar meu numero para poder ser mais autodidático a explicação. GRATO!

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...