Sep 14 2022 06:39 AM - edited Sep 15 2022 01:05 PM
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