VBA - COPIAR PLANILHAS DE VARIOS ARQUIVOS EXCEL

Question

Olá Pessoal, 
Estou criando um VBA onde eu tenho em um diretório 30 arquivos de Excel onde nele tem uma Plan chamada Tabela de Dados, preciso compilar essa tabela de dados dos 30 arquivos em um só, como uma lista de dados um abaixo do outro.

Fiz o codigo abaixo e funcionou para 1 arquivo, mas apartir do segundo não estou conseguindo identificaro motivo que ele nao pega os dados.

Fico agradecido se puderem avaliar e me ajudar.

Sub lsUnificarPlanilhas()

  Dim lUltimaLinhaAtiva As Long
  Dim lRng As Range
  Dim sPath As String
  Dim fName As String
  Dim lNomeWB As String
  Dim lIPlan As Integer
  Dim lUltimaLinhaPlanDestino As Long

  PlanilhaDestino = ThisWorkbook.Name
  sPath = Localizar_Caminho

    sName = Dir(sPath & "\*.xl*")

  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

 Do While sName <> ""
        fName = sPath & "\" & sName
        Workbooks.Open Filename:=fName, UpdateLinks:=False

        lNomeWB = ActiveWorkbook.Name

For lIPlan = 1 To ActiveWorkbook.Sheets.Count




            Workbooks(lNomeWB).Worksheets(lIPlan).Activate

            lUltimaLinhaAtiva = Cells(Rows.Count, 1).End(xlUp).Row
            lUltimaColunaAtiva = ActiveSheet.Cells(1, 5000).End(xlToLeft).Column

            Set lRng = Range(Cells(1, lUltimaColunaAtiva).Address)
            Range("A" & 1 & ":" & gfLetraColuna(lRng) & lUltimaLinhaAtiva).Select
            Selection.Copy

            Workbooks(PlanilhaDestino).Worksheets(1).Activate

            lUltimaLinhaPlanDestino = Cells(Rows.Count, 1).End(xlUp).Row

            If lUltimaLinhaPlanDestino > 1 Then
                lUltimaLinhaPlanDestino = Cells(Rows.Count, 1).End(xlUp).Row + 1
            End If

            Range("A" & lUltimaLinhaPlanDestino).Select

            ActiveSheet.Paste
            Application.CutCopyMode = False
        Next lIPlan

        Workbooks(lNomeWB).Close SaveChanges:=False
        sName = Dir()
  Loop

  MsgBox "Planilhas unificadas!"


  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
End Sub

Function gfLetraColuna(ByVal rng As Range) As String
    Dim lTexto() As String

    lTexto = Split(rng.Address, "$")

    gfLetraColuna = lTexto(1)
End Function

Public Function Localizar_Caminho() As String

    Dim strCaminho As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        'Permitir mais de uma pasta
        .AllowMultiSelect = False

        'Mostrar janela
        .Show

        If .SelectedItems.Count > 0 Then
            strCaminho = .SelectedItems(1)
        End If

    End With

    'Atribuir caminho a variável
    Localizar_Caminho = strCaminho
    End Function