Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Gravar múltiplas cé...
 
Notifications
Clear all

Gravar múltiplas células com VBA

 
2024 - VBA & Macros
Post Recente por FarahA 5 anos atrás
2 Posts
2 Usuários
0 Reactions
1,077 Visualizações
RSS
 kaioaraujo
(@kaioaraujo)
Posts: 2
New Member
Topic starter
 

Olá, sou novo aqui no planilhando achei o fórum em uma pesquisa no google.
Minha duvida que está quebrando minha cabeça estou fazendo uma planilha para um cliente no qual em um recebe os dados e grava na outra, quando faço com 1 Linha ele grava normalmente, porém quando tento mudar para mais de uma linha da erro não grava. vou descrever minha tabela.

Tenho a planilha 1 ("Home") com os seguintes celulas B12 D12 I12 M12 N12 P12 R12 S12 e mais 3 células abaixo dela, quero que os dados em Home vá para a Planilha2 ("Dados") e salve nas células B D I M N P R S. VEJA O CODIGO:

Sub salvar()
    
    Sheets("Home").Select
    
        Dim data As Date
        Dim conf As String
        Dim camp As String
        Dim odds As Double
        Dim valor As Double
        Dim mercado As String
        Dim prov As String
        Dim saldo As Double
    
    Dim mum As Integer
    
        data = Range("B12").Value
        conf = Range("D12").Value
        camp = Range("I12").Value
        odds = Range("M12").Value
        valor = Range("N12").Value
        mercado = Range("P12").Value
        prov = Range("R12").Value
        saldo = Range("S12").Value
    
    
    Sheets("Dados").Select
    mum = Sheets("Dados").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row
    
        Range("B" & mum).Value = data
        Range("D" & mum).Value = conf
        Range("I" & mum).Value = camp
        Range("M" & mum).Value = odds
        Range("N" & mum).Value = valor
        Range("P" & mum).Value = mercado
        Range("R" & mum).Value = prov
        Range("S" & mum).Value = saldo
    
    
    Sheets("Home").Select

        'Range("B12").Value = ""'
        'Range("D12").Value = ""'
        'Range("I12").Value = ""'
        'Range("M12").Value = ""'
        'Range("N12").Value = ""'
        'Range("P12").Value = ""'
        'Range("R12").Value = "" '
        'Range("S12").Value = "" '
    
End Sub

Não sei se estou sendo claro nessa postagem, mas minha questão é esse código funciona com 1 linha mas quero que ele grave mais 3 celulas desde que tenha sido preenchida. Pensei dessa forma porém não da certo.

Sub salvar()
    
    Sheets("Home").Select
    
        Dim data As Date
        Dim conf As String
        Dim camp As String
        Dim odds As Double
        Dim valor As Double
        Dim mercado As String
        Dim prov As String
        Dim saldo As Double
    
    Dim mum As Integer
    
        data = Range("B12").Value
        conf = Range("D12").Value
        camp = Range("I12").Value
        odds = Range("M12").Value
        valor = Range("N12").Value
        mercado = Range("P12").Value
        prov = Range("R12").Value
        saldo = Range("S12").Value
        
        data = Range("B14").Value
        conf = Range("D14").Value
        camp = Range("I14").Value
        odds = Range("M14").Value
        valor = Range("N14").Value
        mercado = Range("P14").Value
        prov = Range("R14").Value
        saldo = Range("S14").Value
        
        data = Range("B16").Value
        conf = Range("D16").Value
        camp = Range("I16").Value
        odds = Range("M16").Value
        valor = Range("N16").Value
        mercado = Range("P16").Value
        prov = Range("R16").Value
        saldo = Range("S16").Value
    
    
    
    Sheets("Dados").Select
    mum = Sheets("Dados").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row
    
        Range("B" & mum).Value = data
        Range("D" & mum).Value = conf
        Range("I" & mum).Value = camp
        Range("M" & mum).Value = odds
        Range("N" & mum).Value = valor
        Range("P" & mum).Value = mercado
        Range("R" & mum).Value = prov
        Range("S" & mum).Value = saldo
    
    
    Sheets("Home").Select

        'Range("B12").Value = ""'
        'Range("D12").Value = ""'
        'Range("I12").Value = ""'
        'Range("M12").Value = ""'
        'Range("N12").Value = ""'
        'Range("P12").Value = ""'
        'Range("R12").Value = "" '
        'Range("S12").Value = "" '
    
End Sub
 
Postado : 30/10/2019 9:02 am
 FarahA
(@faraha)
Posts: 28
Eminent Member
 

Utilizando o código que você elaborou não era para dar erro, mas somente gravar as informações da linha 16 da aba "Home" na última linha vazia da aba "Dados".

Eu realizaria de uma forma diferente da sua, segue o código:

Sub exemplo()

Dim Home As Worksheet, Dados As Worksheet
Dim ulD As Double

Set Home = Sheets("Home")
Set Dados = Sheets("Dados")

For x = 12 To 16 Step 2
ulD = Dados.Cells(Rows.Count, 2).End(xlUp).Row
Dados.Cells(ulD + 1, 2) = Home.Cells(x, 2).Value
Dados.Cells(ulD + 1, 4) = Home.Cells(x, 4).Value
Dados.Cells(ulD + 1, 9) = Home.Cells(x, 9).Value
Dados.Cells(ulD + 1, 13) = Home.Cells(x, 13).Value
Dados.Cells(ulD + 1, 14) = Home.Cells(x, 14).Value
Dados.Cells(ulD + 1, 16) = Home.Cells(x, 16).Value
Dados.Cells(ulD + 1, 18) = Home.Cells(x, 18).Value
Dados.Cells(ulD + 1, 19) = Home.Cells(x, 19).Value

Home.Cells(x, 2).Value = Empty
Home.Cells(x, 4).Value = Empty
Home.Cells(x, 9).Value = Empty
Home.Cells(x, 13).Value = Empty
Home.Cells(x, 14).Value = Empty
Home.Cells(x, 16).Value = Empty
Home.Cells(x, 18).Value = Empty
Home.Cells(x, 19).Value = Empty

Next x
End Sub

Caso queira adicionar mais linhas basta aumentar o valor de 16 para 18,20,22,24 e etc. nesta linha de código:

"For x = 12 To 16 Step 2"

Obs: Esta macro pula 1 linha então caso queira dados das linhas ímpares seria necessário modificar a macro.

 
Postado : 30/10/2019 9:34 am
Forum Jump:
  Tópico Anterior
Próximo Tópico