Tekst af Excel ind i Word

I Word:

Indsæt >>> Indsæt fil... >>> Vælg dine tre ark.

Hejsa i denne lille programstump har jeg navngivet det område, som jeg gerne vil kopiere til Word  =  "rapWord"  Navngiv dit område og kør makroen - husk at lave reference til "Microsoft Word x.0 Object Library" via VBA's Tools/Reference menu

Public Sub CopyToWord()
    Dim MyRapNo As String
    Application.ScreenUpdating = False

    Application.Goto Reference:="rapWord"
    Selection.Copy
    On Error GoTo ShitHappens
   
    'Starter word
    Set mobjWordApp = GetObject(, "Word.Application")
    With mobjWordApp
        .Visible = True
        .Activate
        .Documents.Add
        .Selection.Paste
    End With
   
    GoTo CleanUp
   
ShitHappens:
  Select Case Err.Number
    Case 429
      'Hvis Excel ikke er startet
      Set mobjWordApp = CreateObject("Word.Application")
      'Fortsætter programmet fra næste linie.
      Resume Next
    Case Else
      'Err.Raise Err.Number
  End Select
 
CleanUp:
    Set mobjWordApp = Nothing
    Application.ScreenUpdating = True
End Sub

Hejsa..
Jeg vil jo kun have de linier med som jeg har afkrydset.

Her er et eksempel, som løber igennem alle ark og kigger i kolonne A efter et X, og hvis det findes, så smides det ind i word.

Public Sub CopyToWord()
    Dim objWordApp As Word.Application
    Dim objWordDoc As Word.Document
    Dim wks As Worksheet
    Dim rCell As Range
    Application.ScreenUpdating = False

    On Error GoTo ShitHappens
   
    'Starter word
    Set objWordApp = GetObject(, "Word.Application")
    With objWordApp
        .Visible = True
        Set objWordDoc = .Documents.Add
    End With

    For Each wks In ActiveWorkbook.Worksheets
        For Each rCell In wks.Range("A1").CurrentRegion.Columns(1).Cells
            If UCase(rCell.Value) = "X" Then
                objWordDoc.Range.InsertAfter CStr(rCell.Offset(0, 1).Value) & Chr(13)
            End If
        Next rCell
    Next wks
   
    GoTo CleanUp
   
ShitHappens:
  Select Case Err.Number
    Case 429
      'Hvis Excel ikke er startet
      Set objWordApp = CreateObject("Word.Application")
      'Fortsætter programmet fra næste linie.
      Resume Next
    Case Else
      'Err.Raise Err.Number
  End Select
 
CleanUp:
    Set objWordApp = Nothing
    Set objWordDoc = Nothing
    Set wks = Nothing
    Set rCell = Nothing
    Application.ScreenUpdating = True
End Sub

Hej
Jeg har lidt problemer med at få det til at virke.
Vil du ikke være venlig at sende filerne til mig hh@post4.netmaster.dk

Har du husket at lave referance til word ?