Kopieren von verschiedenen ausgewählten Excel-Bereich in verschiedene Word-Dateien

Question

Ich bin neu in VBA und ich habe seit Ewigkeiten im Internet eine Lösung für mein Problem gesucht. Das Projekt ist, dass ich auf einem Excel-Arbeitsblatt eine Liste der Rezepte mit verschiedenen Schritten, die wie folgt aussieht:

RecipeName RecipeDescription Time Step StepDescription Results 
Burger  Bread + Meat  Short Step1 Open Bread  Bread open  
Burger  Bread + Meat  Short Step2 Cook Meat   Meat cooked  
Soup   Veggie    Short Step1 Instant soup  Soup done 

ich leicht in der Lage bin, einen Bereich zu definieren und in ein Word-Dokument einfügen, aber der schwierige Teil ist, hier:
Ich möchte 1 Wortdokument pro Rezept haben, das zuerst den Rezeptnamen, die Beschreibung und den Zeitheader mit dem tatsächlichen Rezeptnamen, Beschreibung und Zeit gerade unten enthält. Dann folgt jede Schrittnummer, Beschreibung und Ergebnisse. So würde es so aussehen:

Burger 
------ 
RecipeName RecipeDescription Time 
Burger  Bread + Meat  Short 

Step1   Open Bread   Bread open 
Step2   Cook Meat   Meat cooked 

Soup 
---- 
RecipeName RecipeDescription Time 
Soup   Veggie    Short 

Step1   Instant soup  Soup done 

Wie gesagt, bevor ich den Header kopieren und in einem Wort einfügen, aber die Schwierigkeit ist, die Schritte der einzelnen Rezepte auswählen und sie in Wort setzt dann das Wort Speicher Datei in ein vordefiniertes Verzeichnis (der Speicherbereich ist bereits fertig und funktioniert).

Die Idee, die ich hatte, war, den Namen des Rezepts zu nehmen, um zu sortieren, ob wir noch im selben Rezept sind oder ob wir zu einem anderen gesprungen sind.

Funktionell, würde es so aussehen:

For i = 2 to lastRow 
    Open and activate a new word file 
    For j = 2 to lastRow  
    If Cells(j,1) = Cells(j+1; 1) Then 
    Copy Step, Step Description and Results of row(j) 
    Paste into word file 
    Next j 
    Else 
    Copy Step, Step Description and Results of row(i) 
    Paste into word file 
    Save the word file 
    i = j 'So i takes the value of j 
Next i 

Aber ich habe Probleme zwischen i und j ...

Im Moment mein Code wie folgt aussieht, aber bitte entschuldigen Sie mich für die Amateur wie es aussieht:

Sub ExceltoWord() 

    ' 'This part of the code will paste the information into word 

    Dim descriptionHeader As Range 
    Dim stepHeader As Range 
    Dim step As Range 
    Dim descriptionTest As Range 
    Dim lastRow As Integer 
    Dim WordApp As Word.Application 
    Dim myDoc As Word.Document 
    Dim WordTable As Word.Table 

    ' this part of the code will call the rootfolder creation part 

    'Call NewFolder 

    ' Will Set the title and descrption header 
    ThisWorkbook.Sheets("ToWord").Activate 
    Set descriptionHeader = Range("A1:C1") 
    Set stepHeader = Range("D1:F1") 

    'Have the last row stored for later 
    lastRow = WorksheetFunction.CountA(Range("A:A")) 

    'Optimize Code 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 

    'Create an Instance of MS Word 
    On Error Resume Next 

    'Is MS Word already opened? 
    Set WordApp = GetObject(class:="Word.Application") 

    'Clear the error between errors 
    Err.Clear 

    'If MS Word is not already open then open MS Word 
    If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application") 

    'Handle if the Word Application is not found 
    If Err.Number = 429 Then 
     MsgBox "Microsoft Word could not be found, aborting." 
     GoTo EndRoutine 
    End If 

    On Error GoTo 0 

    'Make MS Word Visible and Active 
    WordApp.Visible = True 
    WordApp.Activate 

    'Copy Excel Table Range Paste Table into MS Word 
    For i = 2 To lastRow 
     Set myDoc = WordApp.Documents.Add 
     descriptionHeader.Paste 
     'Need a part here to paste the actual recipe name, description and time 

     For j = 2 To lastRow 
     If Cells(i, 1).Content = Cells(i + 1, 1).Content Then 
      Cells(i, 6).Activate 
      ActiveCell.Offset(0, -2).Range("A1:C1").Select 
      With WordApp.Selection 
      .TypeText Text:=Cell.Text 
      .TypeParagraph 
      End With 
     Next j 
     Else 
      Cells(i, 6).Activate 
      ActiveCell.Offset(0, -2).Range("A1:C1").Select 
      With WordApp.Selection 
      .TypeText Text:=Cell.Text 
      .TypeParagraph 
      End With 

    Next i 

EndRoutine: 
'Optimize Code 
    Application.ScreenUpdating = True 
    Application.EnableEvents = True 

'Clear The Clipboard 
    Application.CutCopyMode = False 

End Sub 

es wurde nun Wochen, dass ich auf dem Excel stecke Teil zu Wort, wie ich gigantische schwier haben tilies, wie man in die Rezepte einleitet und eine Wortdatei für jeden von ihnen speichert.

Vielen Dank im Voraus für Ihre Hilfe,

Jonathan

Answer 1

Kann es jetzt nicht testen, aber Ihre Schleife etwas so aussehen sollte:

Dim RecipeName As String 
Dim DocPath As String 
Dim RecipeText As String 
DocPath = "C:\.....\" 

With ThisWorkbook.Sheets("ToWord") 
    For i = 2 To lastRow 
     If .Cells(i, 1).Value <> RecipeName Then 'New Recipe 
      If Not myDoc Is Nothing Then 
       myDoc.Range().Text = RecipeText 
       myDoc.SaveAs DocPath & RecipeName & ".doc" 
       myDoc.Close False 
      End If 
      RecipeName = .Cells(i, 1).Value 
      Set myDoc = WordApp.Documents.Add 
      RecipeText = .Cells(i, 1) & vbCrLf & "-----" & vbCrLf & .Cells(1, 1) & vbTab & .Cells(1, 2) & vbTab & .Cells(1, 3) & vbCrLf 
      RecipeText = RecipeText & .Cells(i, 1) & vbTab & .Cells(i, 2) & vbTab & .Cells(i, 3) & vbCrLf & vbCrLf 
     End If 

     RecipeText = RecipeText & .Cells(i, 4) & vbTab & .Cells(i, 5) & vbTab & .Cells(i, 6) & vbCrLf 
    Next i 
    myDoc.Range().Text = RecipeText 
    myDoc.SaveAs DocPath & RecipeName & ".doc" 
    myDoc.Close False 

Hoffnung, die