Estou precisando de uma macro que copie da Plan1 e cole na Plan2 repetindo 5 linhas. Os dados a copiar estão na Plan1 numa tabela que começa em B3 e termina em B102. Queria que corresse toda a tabela e copiasse sempre que a coluna B tivesse valor
Plan1 Copiar :
B3 E3 F3
B4 E4 F4
...
Plan2 Colar:
F2 G2 H2
F3 G3 H3
F4 G4 H5
F6 G6 H6
F7 G7 H7
F8 G8 H8
F9 G9 H9
F10 G10 H10
F11 G11 H11
F12 G12 H12
...
https://1drv.ms/x/s!AsGq2_JdxGwDhGy95TQ2nFZrMvZu
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Copiar e copiar em varias linhas
Re: Copiar e copiar em varias linhas
FitaD,
Veja se a rotina abaixo atende sua necessidade.
Veja se a rotina abaixo atende sua necessidade.
Código: Selecionar todos
Sub copiaRange()
Dim rangeCopia As Range
Dim linhaAtual As Long, linhaFinal As Long
Dim novaLinha As Long
Dim contador As Long
Dim nomePlan As String
nomePlan = ""
With ThisWorkbook
.Sheets.Add After:=.Sheets(Sheets.Count)
With .Sheets(Sheets.Count)
.Activate
Range("A1") = "nr"
Range("B1") = "tipo"
Range("C1") = "rua"
Range("D1") = "caixa"
ActiveSheet.Name = "Transferência" & ThisWorkbook.Sheets.Count
nomePlan = "Transferência" & ThisWorkbook.Sheets.Count
End With
With .Sheets("Plan1")
linhaAtual = 2
linhaFinal = .Cells(Rows.Count, 2).End(xlUp).Row
While linhaAtual <= linhaFinal
.Activate
If .Cells(linhaAtual, 2) <> Empty Then
If .Cells(linhaAtual, 3) <> Empty And .Cells(linhaAtual, 4) <> Empty Then
contador = 1
Set rangeCopia = Range("B" & linhaAtual & ":E" & linhaAtual)
novaLinha = ThisWorkbook.Sheets(nomePlan).Cells(Rows.Count, 1).End(xlUp).Row + 1
While Not contador = 6
With rangeCopia
.Copy ThisWorkbook.Sheets(nomePlan).Cells(novaLinha, 1)
End With
contador = contador + 1
novaLinha = ThisWorkbook.Sheets(nomePlan).Cells(Rows.Count, 1).End(xlUp).Row + 1
Wend
End If
End If
contador = 1
linhaAtual = linhaAtual + 1
Wend
End With
End With
MsgBox "Operação realizada com sucesso!", vbInformation, "Transferir dados"
End Sub