Estou criando um script para coletar dados em uma planilha,colar em outras duas o dado copiado.Na planilha que pego os dados ela me mostra quais planilhas serão copiadas, quer dizer, atravez dela eu pego minha matriz de onde colo em duas outras. Portanto preciso de um loop na planilha matriz e outro no copia e cola. Não estou conseguindo Gerar um Loop onde após copiar a primeira linha, passe para segunda.
Alguem poderia me ajudar nessa questão ?
Sub Copiar_e_imprimir()
Dim UltimaLinha As Long
Dim ULinha As Integer
Dim N As Workbook
Dim U As Worksheet
Dim i As Long
Dim Linha As Long
Dim URL As String
Dim Arquivo As String
Worksheets("Modimp").Activate
Range("A2:H1000").ClearContents
ThisWorkbook.Worksheets("Modimp").Cells(1, 1).Value = "POSIÇÃO"
ThisWorkbook.Worksheets("Modimp").Cells(1, 2).Value = "NM"
ThisWorkbook.Worksheets("Modimp").Cells(1, 3).Value = "DESCRIÇÃO"
ThisWorkbook.Worksheets("Modimp").Cells(1, 4).Value = "UN"
ThisWorkbook.Worksheets("Modimp").Cells(1, 5).Value = "QTD"
ThisWorkbook.Worksheets("Modimp").Cells(1, 6).Value = "DANIF"
ThisWorkbook.Worksheets("Modimp").Cells(1, 7).Value = "VENC"
ThisWorkbook.Worksheets("Modimp").Cells(1, 8).Value = "INCOM"
Worksheets("Arquivos para Criar").Activate
UltimaLinha = ThisWorkbook.Worksheets("Arquivos para Criar").Cells(Rows.Count, 1).End(xlUp).Row
Linha = 2
Do Until Linha > UltimaLinha
'pega o caminho pre selecionado do arquivo matriz. Preciso de um Loop nessa para verificar as linhas.
URL = ThisWorkbook.Worksheets("Arquivos para Criar").Cells(Linha, 2).Value
Arquivo = ThisWorkbook.Worksheets("Arquivos para Criar").Cells(Linha, 1).Value
Workbooks.Open URL & Arquivo
Set N = Workbooks.Open(URL & Arquivo)
' mais um Loop aqui para puxar as linhas de baixo em sequencia
ULinha = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Range("A2").Select
Selection.Copy
ThisWorkbook.Worksheets("Modimp").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
N.Activate
Range("B2").Select
Selection.Copy
ThisWorkbook.Worksheets("Modimp").Activate
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
N.Activate
Range("C2").Select
Selection.Copy
ThisWorkbook.Worksheets("Modimp").Activate
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
N.Activate
Range("E2").Select
Selection.Copy
ThisWorkbook.Worksheets("Modimp").Activate
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Loop
End Sub
Gabriel Soar...
Novo Membro
Registrado
1 Mensagem
0 Curtidas