Este fórum está sendo desativado

[DonCelio]

Preciso de ajuda para ajustar o código abaixo. Esse código consolida as planilhas existentes na pasta de trabalho, porém, não traz a formatação original, assim, gostaria de ajustá-lo para que trouxesse os formatos, fórmulas, etc., das planilhas para a planilha consolidada.

Obrigado.

Célio

Código: Selecionar todos

Sub Consolida()

Dim J As Integer

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

On Error Resume Next
    Sheets(1).Delete
    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "Consolidado"
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")

For J = 2 To Sheets(3)
    Sheets(J).Activate
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
    Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub

[alexandrevba]

Bom dia!!
Não tentado.

Código: Selecionar todos

Sub Consolida()

Dim J As Integer

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

On Error Resume Next
    Sheets(1).Delete
    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "Consolidado"
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")

For J = 2 To Sheets(3)
    Sheets(J).Activate
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
    Selection.Copy 'Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
    Selection.PasteSpecial xlPasteFormats 'Tente assim.....Obs não testado
Next

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub

Att

[DonCelio]

Alexandre, não funcionou, mas mesmo assim, obrigado pela atenção.
Bom dia.

[DonCelio]

Com mais algumas pesquisas e com o gravador de macro consegui fazer os ajustes.
Caso alguém queira aproveitar o código ele faz o seguinte:

1) Deleta a primeira planilha;
2) Cria uma nova planilha;
3) Nomeia a nova planilha como "Consolidado";
4) Copia a linha A1 da planilha 2 para a planilha Consolidado recém criada;
5) Auto redimensiona as colunas da planilha Consolidado;
6) Copia para a planilha Consolidado cada planilha existente com os respectivos formatos e fórmulas;
7) A última parte foi apenas para "perfumaria". Coloca bordas nos dados copiados. Coloca um autofiltro e deixa o cursor na célula J2.

Segue o código:

Código: Selecionar todos

Sub Consolida()

Dim J As Integer
Dim lngCalc As Long

With Application
    .DisplayAlerts = False
    .EnableEvents = False
    .ScreenUpdating = False
    lngCalc = .Calculation
    .Calculation = xlCalculationManual
End With

On Error Resume Next
    Sheets(1).Delete
    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "Consolidado"
    Sheets(2).Activate
    Range("A1").EntireRow.Copy
    Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets(1).Columns.AutoFit
    
For J = 2 To Sheets.Count
    Sheets(J).Activate
    Range("A1").CurrentRegion.Select
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Copy
    Sheets("Consolidado").Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Next
    Sheets(1).Activate
    Sheets(1).Columns.AutoFit
    Sheets(1).Range("A1").CurrentRegion.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    Range("A1:K1").AutoFilter
    Range("J2").Select
    
With Application
    .CutCopyMode = False
    .DisplayAlerts = True
    .EnableEvents = True
    .ScreenUpdating = True
    .Calculation = lngCalc
End With

End Sub