Logo Hardware.com.br
Gabriel Soares Suhett
Gabriel Soar... Novo Membro Registrado
1 Mensagem 0 Curtidas

Copiar e colar em planilhas diferentes, com loop VBA.

#1 Por Gabriel Soar... 06/02/2019 - 14:53
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
© 1999-2024 Hardware.com.br. Todos os direitos reservados.
Imagem do Modal