Public Sub AlleZellenNachWordAuslesen()
Dim MeineRange As Range
Dim Inhalt As String
Dim AnzahlSpalten As Long
Dim AnzahlZeilen As Long
Dim Zeile As Long
Dim Spalte As Long
Rem Verweis nicht vergessen Microsoft Word 8.0 Object Library
Dim MeinWord As Word.Application
On Error Resume Next
Set MeinWord = GetObject(, "Word.Application")
If MeinWord Is Nothing Then
    Set MeinWord = New Word.Application
End If
With MeinWord
  Rem diese Dinge kann man machen, muß aber nicht
  .Visible = True
  .Activate
  .WindowState = wdWindowStateMaximize
End With
 
 
Rem Hier kann der Anfang einer Schleife sein
AnzahlSpalten = ActiveCell.SpecialCells(xlLastCell).Column
AnzahlZeilen = ActiveCell.SpecialCells(xlLastCell).Row
With MeinWord
    .Documents.Add
    .ActiveDocument.Tables.Add Range:=.Selection.Range, NumRows:=AnzahlZeilen, _
      NumColumns:=AnzahlSpalten
End With
Set MeineRange = Range("A1:" & ActiveCell.SpecialCells(xlLastCell).Address)
For Zeile = 1 To AnzahlZeilen
    For Spalte = 1 To AnzahlSpalten
        Inhalt = MeineRange.Cells(Zeile, Spalte).Text
        With MeinWord
            .Selection.TypeText Inhalt
            .Selection.MoveRight Unit:=wdCell
        End With
    Next
Next
With MeinWord
    .Selection.Rows.Delete
    Rem Hier das Worddokument speichern
End With
Rem Hier kann das Ende einer Schleife sein
 
 
Set MeinWord = Nothing
End Sub