Hallo zusammen,

Ich möchte aus Word heraus Daten per Makro nach Excel kopieren. Das klappt mitlerweile auch ganz gut, nur kriege ich es nicht hin, die erste Zeile zu fixieren, um beim Scrollen immer die Kopfzeile sehen zu können (sie soll also beim Scrollen nicht verschwinden). Mein Code sieht wie folgt aus:

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
     
    'HIER TRITT DER FEHLER AUF
     With sWorkbook.ActiveSheet.Rows("2:2")
        .FreezePanes = True
    End With

    
    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

Wenn ich das Makro laufen lassen will, bekomme ich die Fehlermeldung "Laufzeitfehler 438 - Das Objekt unterstützt diese Eigenschaft oder Methode nicht." Ich arbeite mit Office 2003 und finde irgendwie nicht, wie es richtig aussehen muss. Über Hilfe jeder ARt würde ich mich freuen.

Gruß,

Björn