VBA Word-Zellen in Excel Tabelle

Sub Übrsicht()
Dim cL As Object
Dim sPfad As String
Dim appWord As Object
Dim i As Long
Dim a As Long
Dim counter As Long
Dim cDir As String
counter = 0
'WordObject erstellen
Set appWord = CreateObject("Word.Application")
'Pfad
sPfad = "C:\Users\Desktop\test\"
cDir = Dir(sPfad & "*.docx")
Do While cDir  ""
'Worddocument öffnen
appWord.Documents.Open sPfad & cDir
'Wordtabelle auslesen
'Zeilen
For a = 1 To 3
i = 0
'Spalten
For Each cL In appWord.activeDocument.Tables(1).Rows(a).Cells
i = i + 1
ActiveWorkbook.ActiveSheet.Cells(a + counter, i) = Left(cL.Range.Text, Len(cL.Range.Text) - 2)
Next
Next a
'Worddocument schliessen
appWord.activeDocument.Close savechanges:=False
'nächstes Document lesen
cDir = Dir
counter = counter + 3
Loop
'WordObject löschen
Set appWord = Nothing
End Sub