Macro em loop, com If para copiar e colar em outra planilha
Enviado: Sex Ago 09, 2019 4:43 pm
Preciso de um código em LOOP para fazer a pesquisa de uma determinada palavra em uma coluna na planilha 1.
Caso encontre essa palavra, e todas as vezes em que ela se repetir, deverá executar um copiar e colar.
Segue exemplo:
If Worksheets("Planilha1").Range("G2") = "Treinado" Then
ThisWorkbook.Sheets("Planilha2").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ThisWorkbook.Sheets("Planilha1").Range("G2").Copy
ThisWorkbook.Sheets("Planilha2").Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ThisWorkbook.Sheets("Planilha1").Range("H2").Copy
ThisWorkbook.Sheets("Planilha2").Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
End If
If Worksheets("Planilha1").Range("G3") = "Treinado" Then
ThisWorkbook.Sheets("Planilha2").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ThisWorkbook.Sheets("Planilha1").Range("G3").Copy
ThisWorkbook.Sheets("Planilha2").Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ThisWorkbook.Sheets("Planilha1").Range("H3").Copy
ThisWorkbook.Sheets("Planilha2").Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
End If
Este código funciona, porém teria que repetir o IF para todas as células da coluna G e ficaria um código muito grande. Acredito que um código em loop poderia resolver.
Caso encontre essa palavra, e todas as vezes em que ela se repetir, deverá executar um copiar e colar.
Segue exemplo:
If Worksheets("Planilha1").Range("G2") = "Treinado" Then
ThisWorkbook.Sheets("Planilha2").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ThisWorkbook.Sheets("Planilha1").Range("G2").Copy
ThisWorkbook.Sheets("Planilha2").Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ThisWorkbook.Sheets("Planilha1").Range("H2").Copy
ThisWorkbook.Sheets("Planilha2").Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
End If
If Worksheets("Planilha1").Range("G3") = "Treinado" Then
ThisWorkbook.Sheets("Planilha2").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ThisWorkbook.Sheets("Planilha1").Range("G3").Copy
ThisWorkbook.Sheets("Planilha2").Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ThisWorkbook.Sheets("Planilha1").Range("H3").Copy
ThisWorkbook.Sheets("Planilha2").Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
End If
Este código funciona, porém teria que repetir o IF para todas as células da coluna G e ficaria um código muito grande. Acredito que um código em loop poderia resolver.