Vba Copiar Linha determinando as colunas e colar em outra planilha

Question

Pessoal

Tenho o seguinte macro abaixo, porem gostaria de especificar o campo de busca
ao invés de buscar a linha inteira para copiar e colar, queria que buscasse
apenas a linha da coluna A ate a coluna S e colasse na outra planilha.<o:p></o:p>

Sub GAZGLPGRANEL()

Dim vLocalizaLinha As Integer
Dim vCopiaLinha As Integer
Sheets("GAZ - GLP GRANEL").Select
Range("a2:S5000").ClearContents
Sheets("Relatorio Movimentação Estoque").Select
On Error GoTo Err_Execute

'Inicia busca na linha 2
vLocalizaLinha = 2

'Start copying data to row 2 in Plan2 (row counter variable)
'Comece a copiar dados para linha 2 em Plan2 (linha contariam a variável)
vCopiaLinha = 2

While Len(Range("A" & CStr(vLocalizaLinha)).Value) > 0

'Se valor na coluna G = "GAZ - GLP GRANEL", copie a linha inteira a Plan2
If Range("G" & CStr(vLocalizaLinha)).Value = Range("x1").Value Then

'selecionando a planilha 1 para copiar
Rows(CStr(vLocalizaLinha) & ":" & CStr(vLocalizaLinha)).Select
Selection.Copy

'colando na planilha 2 na proxima linha
Sheets("GAZ - GLP GRANEL").Select
Rows(CStr(vCopiaLinha) & ":" & CStr(vCopiaLinha)).Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, _
Transpose:=False
Application.CutCopyMode = False
   
'Contador move para a proxima linha
vCopiaLinha = vCopiaLinha + 1

'volta para Planilha1 e continua a busca
Sheets("Relatorio Movimentação Estoque").Select

End If

vLocalizaLinha = vLocalizaLinha + 1

Wend

'reposiciona na celula (A3)
Application.CutCopyMode = False
Range("A2").Select

Sheets("Menu").Select

MsgBox "Todos os dados procurados binderfaixa2 foram copiados ."

Exit Sub

Err_Execute:
MsgBox "ocorreu um erro.", vbInformation, "Saberexcel - o site das macros"
 
End Sub

Answer 1

Olá,

Estou movendo este post para a categoria de VBA...

Por favor, das próximas vezes que tiver alguma dúvida relacionada a esse assunto, poste por lá...

Obrigado...

---

André Alves de Lima
Microsoft MVP - Client App Dev
Visite o meu site: http://www.andrealveslima.com.br
Me siga no Twitter: @andrealveslima

Answer 2

Sub GAZGLPGRANEL()

    Dim vLocalizaLinha As Integer
    Dim vCopiaLinha As Integer
    Sheets("GAZ - GLP GRANEL").Select
    Range("a2:S5000").ClearContents
    Sheets("Relatorio Movimentação Estoque").Select
    On Error GoTo Err_Execute

    'Inicia busca na linha 2
    vLocalizaLinha = 2

    'Start copying data to row 2 in Plan2 (row counter variable)
    'Comece a copiar dados para linha 2 em Plan2 (linha contariam a variável)
    vCopiaLinha = 2

    While Len(Range("A" & CStr(vLocalizaLinha)).Value) > 0

        'Se valor na coluna G = "GAZ - GLP GRANEL", copie a linha inteira a Plan2
        If Range("G" & CStr(vLocalizaLinha)).Value = Range("x1").Value Then

            'selecionando a planilha 1 para copiar
            Cells(vLocalizaLinha).Resize(14).Copy

            'colando na planilha 2 na proxima linha
            Sheets("GAZ - GLP GRANEL").Range("A:" & vCopiaLinha).PasteSpecial Paste:=xlPasteValues
            
            Application.CutCopyMode = False

            'Contador move para a proxima linha
            vCopiaLinha = vCopiaLinha + 1

            'volta para Planilha1 e continua a busca
            Sheets("Relatorio Movimentação Estoque").Select

        End If

        vLocalizaLinha = vLocalizaLinha + 1

    Wend

    'reposiciona na celula (A3)
    Application.CutCopyMode = False
    Range("A2").Select

    Sheets("Menu").Select

    MsgBox "Todos os dados procurados binderfaixa2 foram copiados ."

    Exit Sub

Err_Execute:
    MsgBox "ocorreu um erro.", vbInformation, "Saberexcel - o site das macros"

End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br