Hallo zusammen,

ich hab ein Problem und komme damit nicht weiter, vielleicht könnt ihr mir ja helfen.

Ich habe ein Word Dokument, in dem sich mehrere Tabellen befinden. Diese Tabellen möchte ich per Makro in eine Exceldatei kopieren. Das klappt auch, hier kommt mein Problem: Wie kann ich den Text in den Zellen links oben ausrichten? Bisher ist mein Text unten ausgerichtet und ob links oder rechts hängt, wie üblich, daran, ob es eine Zahl oder "echter" Text ist. Mein Code sieht aus wie folgt:

Sub Test()
    Dim t As Table
    Dim r As Row
    Dim cL As Cell
    Dim sPfad As String
    Dim sFile As String
    Dim appExcel As Object
    Dim sWorkbook As Object
    Dim i As Long
    Dim counter As Long
    Dim strWorkbook As String
    Dim j As Long
    Dim bLetzte As Boolean
    Dim col As Column
    
    'Pfad
    sPfad = "C:\Dokumente und Einstellungen\bgrundey\Eigene Dateien"
    'Dateiname
    sFile = "Test.xls"

    'ExcelObject erstellen
    Set appExcel = CreateObject("Excel.Application")
   
    'neue ExcelDatei erstellen
    Set sWorkbook = appExcel.Workbooks.Add
          
    sWorkbook.ActiveSheet.Cells.WrapText = True
        
    'Festlegen, dass es sich bei Programmstart nicht um die letzte Tabelle handelt
    bLetzte = False
        
    counter = 0
   
    'Wordtabelle auslesen
    For Each t In ActiveDocument.Tables
        i = 0
        j = 0
        
        If counter > 1 Then
            For Each r In t.Rows
                For Each cL In r.Cells
                    'Falls es sich um die Definitionstabelle handelt, wird die Variable für die letzte Tabelle des Dokuments True
                    If (InStr(1, cL.Range.Text, "Begriff") = 1) Then
                        bLetzte = True
                    End If
                    i = i + 1
                    'Die Inhalte werden ohne Bezeichner und nicht aus der letzten Tabelle des Dokumentes übernommen.
                    If (i Mod 2 = 0) And (bLetzte = False) Then
                        j = i - (i \ 2)
                        'Wert aus jeder zweiten Zelle nach Excel übertragen
                        sWorkbook.ActiveSheet.Cells(counter, j) = Left(cL.Range.Text, Len(cL.Range.Text) - 2)
                    End If
                Next
            Next
        End If
        counter = counter + 1
    Next
    
   'ExcelDatei speichern unter
    sWorkbook.SaveAs sPfad & "\" & sFile
   
    'ExcelDatei schliessen
    sWorkbook.Close True
 
    'ExcelObject löschen
    Set appExcel = Nothing
End Sub

Falls mir jemand weiterhelfen kann, wäre ich dankbar.

Gruß,

Björn