Excel Unificar abas do excel pelo VBA

[MichelReis]

Olá pessoa!

 

Uma ajuda por favor...

 

Estou tentando unificar as abas de uma planilha (cerca de 90 abas), e estou usando o código conforme mais abaixo. Achei alguns tópicos sobre o assunto mas nenhum esclareceu a minha duvida.

 

Todas as abas possuem o mesmo cabeçalho (linhas 1 e 2), porém, quero unificar todas em uma só mantendo o cabeçalho apenas uma unica vez, copiando somente as informações das outras sheets (abaixo do cabeçalho). Caso alguém tenha algum outro código...agradeço!

 

Resumo do codigo:

ele cria uma nova sheet, 

copia todas as demais e unifica as informações uma abaixo da outra, mas copia tudo, só quero o q esta abaixo do cabeçalho.

 

 

Sub Combine()
'
    Dim I As Long
    Dim xRg As Range
    On Error Resume Next
    Worksheets.Add Sheets(1)
    ActiveSheet.Name = "Combined"
   For I = 2 To Sheets.Count
        Set xRg = Sheets(1).UsedRange
        If I > 2 Then
            Set xRg = Sheets(1).Cells(xRg.Rows.Count + 1, 1)
        End If
        Sheets(I).Activate
        ActiveSheet.UsedRange.Copy xRg
    Next
    
End Sub

 

 

 

[AfonsoMira]

@MichelReis Boas experimente o seguinte código.

Sub Combine()

Dim I As Long
Dim ultimaLinha As Long
On Error Resume Next
Application.ScreenUpdating = False
Worksheets.Add Sheets(1)
ActiveSheet.Name = "Combined"
For I = 2 To Sheets.Count

If I = 2 Then
    Sheets(I).Select
    Sheets(I).UsedRange.Copy
    Sheets("Combined").Paste
Else
    Sheets(I).Select
    Range("A2").Select
    Range(selection, selection.End(xlToRight)).Select
    Range(selection, selection.End(xlDown)).Select
    selection.Copy
    ultimaLinha = Sheets("Combined").Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Combined").Cells(ultimaLinha + 1, 1).PasteSpecial xlValues
End If

Next I

Application.ScreenUpdating = True
    
End Sub