將不同的選定excel範圍複製到不同的word文件中

Question

我是vba的新手，我已經在網上搜索了一些關於我的問題的解決方案。 該項目是我有一個Excel工作表以不同的步驟配方列表看起來像這樣：

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 

我能夠輕鬆地定義範圍並將其粘貼到一個Word文檔，但棘手的問題是這裏：
我希望每個配方有一個word文檔，首先包含配方名稱，描述和時間標題，其中包含實際配方名稱，描述和時間。然後將會跟隨每個步驟編號，說明和結果。 所以它應該是這樣的：

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 

正如前面所說，我可以複製標題並將其粘貼到一個字，但難的是選擇每個配方的步驟，並把它放入字然後保存字文件放入預定義的目錄（保存部分已經完成並正在工作）。

我的想法是將配方名稱作爲一種排序方式，如果我們仍然處於相同配方或者我們跳到另一個配方。

功能上，它會是這樣：

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 

但我有i和j之間的問題......

就目前我的代碼看起來是這樣，但請原諒我的它看起來業餘：

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 

現在已經幾個星期，我粘在Excel中單詞的一部分，因爲我有巨大的diffic解決如何循環進入食譜併爲每個食譜保存一個單詞文件。

預先感謝您的幫助，

喬納森

Answer 1

現在不能測試，但你的循環應該看起來有點像：

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 

希望幫助