COPIAR DADOS COM LOOP ENTRE DUAS PLANILHAS!!!

Copper Contributor

BOA TARDE A TODOS!!

 

JA QUE ATÉ AGORA SOMENTE HOUVE VISUALIZAÇÕES, RESOLVI EDITAR ESTE POST!!!

ENCONTREI ESTE OUTRO CÓDIGO, FIZ UMAS ADAPTAÇÕES, MAS PRECISA DE MELHORIAS!!! ALGUÉM PODE AJUDAR. SEGUE O CÓDIGO=>

 

Sub ListarPessoas()
Dim Intervalo As String, Cellula As Range

 

(ESTA PARTE AQUI, NÃO SEI EXATAMENTE O QUE FAZ)


Dim ContarCabeçalho As Integer 
Dim Cabeçalho As String

ContarCabeçalho = 1

 


linha_resumo = 3
linha_dados = 4

 

(ESTAS VARIÁVEIS FAZEM PARTE DA EXECUÇÃO DO CÓDIGO DENTRO FOR)


linha_resumo2 = 4 
linha_dados2 = 5

Planilhas("IMPRESSÃO2").Selecione
Células.Delete Shift:=xlUp
Range("A1:G1").Merge
Range ("A1:G1").Valor = "LISTA DE OBEIROS"
Selection.Font.Bold = True
Range("A2:G2").Selecione

 

(ESTA PARTE AQUI, CRIA UM CABEÇALHO NA PARTE SUPERIOR, PRECISA SER MELHORADO )

 

Seleção.Mesclar 
Range("A2:G2").Value = "'===================================== = ==========================="
Com Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0,249977111117893
. PatternTintAndShade = 0
Terminar Com
Com Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
Terminar com


Set Intervalo = Sheets("BANCO").Range("A5:W162")

Para Cada Célula Sem Intervalo

Select Case ContarCabeçalho
Case Is = 1
Cabeçalho = Sheets("BANCO").Range("B2")

 

                (TODA ESTA PARTE PARTE, FAZ PARTE DA COPIA DE DADOS DE UMA PLANILHA PARA OUTRA, MAS EM FORMA DE RELATÓRIO, TAMBÉM PRECISA DE MELHORIA E DETALHE=> ESTA PARTE DEVERIA OBEDECER O CRITÉRIO DO CABEÇALHO, OU SEJA COPIAR APENAS AS LINHAS DE DADOS QUE PARA IGUAL AO CRITÉRIO, MAS NA PRATICA ESTÁ COPIANDO TODAS AS LINHAS.)


'PRIMEIRO TRECHO DO CABEÇALHO
Planilha5.Cells(linha_resumo, 1).Valor = Planilha6.Cells(linha_dados, 1)
.Valor Planilha5.Cells(linha_resumo, 2).Valor = Planilha6.Cells(linha_dados, 2)
.Valor Planilha5.Cells (linha_resumo, 3).Valor = Planilha6.Cells(linha_dados, 3)
.Valor Planilha5.Cells(linha_resumo, 4).Valor = Planilha6.Cells(linha_dados, 4)
.Valor Planilha5.Cells(linha_resumo, 5).Valor = Planilha6.Cells(linha_dados, 5)
.Valor Planilha5.Cells(linha_resumo, 6).Valor = Planilha6.Cells(linha_dados, 6)
.Valor Planilha5.Cells(linha_resumo, 7).Valor = Planilha6.Cells(linha_dados, 7) .Valor
linha_resumo = linha_resumo + 2

'SEGUNDO TRECHO DO CABEÇALHO
Planilha5.Cells(linha_resumo, 1).Valor = Planilha6.Cells(linha_dados, 8).Valor
Planilha5.Cells(linha_resumo, 2).Value = Planilha6.Cells(linha_dados, 9).Value
Planilha5.Cells(linha_resumo, 3).Value = Planilha6.Cells(linha_dados, 10).Value
Planilha5.Cells(linha_resumo, 4).Value = Planilha6.Cells(linha_dados, 11).Value
Planilha5.Cells(linha_resumo, 5).Value = Planilha6.Cells(linha_dados, 12).Value
Planilha5.Cells(linha_resumo, 6).Value = Planilha6.Cells(linha_dados, 13).Value
Planilha5.Cells(linha_resumo, 7).Value = Planilha6.Cells(linha_dados, 14).Value
linha_resumo = linha_resumo + 2

'TERCEIRO TRECHO DO CABEÇALHO
Planilha5.Cells(linha_resumo, 1).Value = Planilha6.Cells(linha_dados, 15).Value
Planilha5.Cells(linha_resumo, 2).Value = Planilha6.Cells(linha_dados, 16).Value
Planilha5.Cells(linha_resumo, 3).Value = Planilha6.Cells(linha_dados, 17).Value
Planilha5.Cells(linha_resumo, 4).Value = Planilha6.Cells(linha_dados, 18).Value
Planilha5.Cells(linha_resumo, 5).Value = Planilha6.Cells(linha_dados, 19).Value
Planilha5.Cells(linha_resumo, 6).Value = Planilha6.Cells(linha_dados, 20).Value
Planilha5.Cells(linha_resumo, 7).Value = Planilha6.Cells(linha_dados, 21).Value
linha_resumo = linha_resumo + 2


'QUARTO TRECHO DO CABEÇALHO
Planilha5.Cells(linha_resumo, 1).Value = Planilha6.Cells(linha_dados, 22).Value
Planilha5.Cells(linha_resumo, 2).Value = Planilha6.Cells(linha_dados, 23).Value
linha_resumo = linha_resumo + 3

'PRIMEIRO TRECHO DOS DADOS DE OBREIROS
Planilha5.Cells(linha_resumo2, 1).Value = Planilha6.Cells(linha_dados2, 1).Value
Planilha5.Cells(linha_resumo2, 2).Value = Planilha6.Cells(linha_dados2, 2).Value
Planilha5.Cells(linha_resumo2, 3).Value = Planilha6.Cells(linha_dados2, 3).Value
Planilha5.Cells(linha_resumo2, 4).Value = Planilha6.Cells(linha_dados2, 4).Value
Planilha5.Cells(linha_resumo2, 5).Value = Planilha6.Cells(linha_dados2, 5).Value
Planilha5.Cells(linha_resumo2, 6).Value = Planilha6.Cells(linha_dados2, 6).Value
Planilha5.Cells(linha_resumo2, 7).Value = Planilha6.Cells(linha_dados2, 7).Value
linha_resumo2 = linha_resumo2 + 2

'SEGUNDO TRECHO DOS DADOS DE OBREIROS
Planilha5.Cells(linha_resumo2, 1).Value = Planilha6.Cells(linha_dados2, 8).Value
Planilha5.Cells(linha_resumo2, 2).Value = Planilha6.Cells(linha_dados2, 9).Value
Planilha5.Cells(linha_resumo2, 3).Value = Planilha6.Cells(linha_dados2, 10).Value
Planilha5.Cells(linha_resumo2, 4).Value = Planilha6.Cells(linha_dados2, 11).Value
Planilha5.Cells(linha_resumo2, 5).Value = Planilha6.Cells(linha_dados2, 12).Value
Planilha5.Cells(linha_resumo2, 6).Value = Planilha6.Cells(linha_dados2, 13).Value
Planilha5.Cells(linha_resumo2, 7).Value = Planilha6.Cells(linha_dados2, 14).Value
linha_resumo2 = linha_resumo2 + 2

'TERCEIRO TRECHO DOS DADOS DE OBREIROS
Planilha5.Cells(linha_resumo2, 1).Value = Planilha6.Cells(linha_dados2, 15).Value
Planilha5.Cells(linha_resumo2, 2).Value = Planilha6.Cells(linha_dados2, 16).Value
Planilha5.Cells(linha_resumo2, 3).Value = Planilha6.Cells(linha_dados2, 17).Value
Planilha5.Cells(linha_resumo2, 4).Value = Planilha6.Cells(linha_dados2, 18).Value
Planilha5.Cells(linha_resumo2, 5).Value = Planilha6.Cells(linha_dados2, 19).Value
Planilha5.Cells(linha_resumo2, 6).Value = Planilha6.Cells(linha_dados2, 20).Value
Planilha5.Cells(linha_resumo2, 7).Value = Planilha6.Cells(linha_dados2, 21).Value
linha_resumo2 = linha_resumo2 + 2

'QUARTO TRECHO DOS DADOS DE OBREIROS
Planilha5.Cells(linha_resumo2, 1).Value = Planilha6.Cells(linha_dados2, 22).Value
Planilha5.Cells(linha_resumo2, 2).Value = Planilha6.Cells(linha_dados2, 23).Value
linha_resumo2 = linha_resumo2 + 3
linha_dados2 = linha_dados2 + 1

 

End Select

Range(Cells(linha_resumo2 - 2, 1), Cells(linha_resumo2 - 2, 7)).Select
Selection.Merge
Planilha5.Cells(linha_resumo2 - 2, 1).Value = "'================================================================"
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic           

 

( ESTA PARTE, CRIA UM DIVISOR ENTRE CADA LINHA DE DADOS, ESTA LINHA DE DADOS, TEM 23 COLUNAS E SÃO COPIADAS PARA OUTRA PLANILHA, DIVIDA EM QUATRO PARTES, ENTÃO UMA LINHA DIVIDA EM 4 LINHAS DE DADOS, COM 4 LINHAS DE CABEÇALHO E ESTE TRECHO, COLOCA UM DIVISOR ENTRE CADA TRECHO DE 8 LINHAS)


.ThemeColor = xlThemeColorDark1          
.TintAndShade = -0.249977111117893     
.PatternTintAndShade = 0                         
End With                                                    
With Selection.Font                                    
.ThemeColor = xlThemeColorDark1           
.TintAndShade = -0.249977111117893
End With

' Debug.Print Cabeçalho & Celula
'
'
' ContarCabeçalho = ContarCabeçalho + 1

 

( ESTE TRECHO FAZ PARTE DO CÓDIGO ORIGINAL, MAS NÃO SEI EXATAMENTE O QUE FAZ)


' If ContarCabeçalho > 1 Then
' ContarCabeçalho = 1                                   
' Debug.Print "---------------------------"          
' End If

Next
End Sub

 

PRECISO DA AJUDA DE VOCÊS!!! DESDE JÁ AGRADEÇO PELA AJUDA!!!

SE PRECISAR E TIVER COMO, POSSO ENCAMINHAR A PLANILHA PRA VOCÊS ANALIZAREM, TA BOM!!!

 

ATENCIOSAMENTE

 

 

JOÃO BATISTA

0 Replies