嘗試使用Excel VBA跳過復制/粘貼循環中的空白行

Question

我在Excel文件中有一個訂單項的復制/粘貼循環，可將這些訂單項中的數據導出到基於Excel的表單中，並按行B中的值保存每個表單。我的問題是，這些訂單項分為3種同一張紙上的表格，每個表格都有不同數量的要復制的訂單項。 此外，每個表由2個空白行分隔。

我需要宏為我做什么：

1. 從第17行開始，復制第一個表格中的所有訂單項，直到它到達空白行-從1到600行不等。
2. 跳到SecondTable並執行相同的功能。
3. 重復ThirdTable

當我刪除大量代碼以提高可讀性時，請忽略某些聲明。 我認為我需要3個單獨的復制/粘貼循環來完成此操作（這里僅包括2個），並且嘗試使用.Find引用第二個/第三個表的開始。 宏在第一個表中正常運行，但是在遇到空白行時不會停止，而在嘗試根據空單元格的值保存文件時會失敗。 我相信問題在於EndOne = .Range("B" & .Rows.Count).End(xlUp).Row變量位於With wsSource 。 它不計算第一張表的非空白行，而是計算到第三張表的末尾的行數。

Sub CopyToForm()

Dim wbSource As Workbook, wbForm As Workbook
Dim wsSource As Worksheet, wsForm As Worksheet
Dim formpath As String, foldertosavepath As String
Dim EndOne As Long, EndTwo As Long, EndThree As Long, i As Integer
Dim strProcessingFormPath As String
'Dim strCancel As String
'Dim strFilt As String
'Dim intFilterIndex As Integer
'Dim strDialogueFileTitle As String
Dim SecondTable As String
Dim ThirdTable As String

Set wbSource = ThisWorkbook '~~> Write your code in Indication Tool.xls
Set wsSource = wbSource.Sheets("Indication Tool") '~~> Put the source sheet name


With wsSource
    '~~> Counts how many rows are in the Indication Tool
    EndOne = .Range("B" & .Rows.Count).End(xlUp).Row
    If EndOne < 17 Then MsgBox "No data for transfer": Exit Sub
    For i = 17 To EndOne
        Set wbForm = Workbooks.Open(formpath) '~~> open the form
        Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
        '~~> Proceed with the copying / pasting of values
        .Range("B" & i).Copy wsForm.Range("F7:K7")
        .Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
        .Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
        .Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
        .Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
        .Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
        .Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
        .Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
        .Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
        .Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
        '.Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
        '~~> Save the form using the value in cell i,B
        wbForm.SaveAs .Range("B" & i).Value & ".xls"
        wbForm.Close
        Set wbForm = Nothing
        Set wsForm = Nothing
   Next

End With

With wsSource
    SecondTable = .Range("B:B").Find("SecondTable").Row
    EndTwo = .Range("B" & .Rows.Count).End(xlUp).Row
    For i = Second Table + 1 To EndTwo
        Set wbForm = Workbooks.Open(formpath) '~~> open the form
        Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
        '~~> Proceed with the copying / pasting of values
        .Range("B" & i).Copy wsForm.Range("F7:K7")
        .Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
        .Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
        .Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
        .Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
        .Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
        .Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
        .Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
        .Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
        .Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
        .Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
        '~~> Save the form using the cells i,B
        wbForm.SaveAs .Range("B" & i).Value & ".xls"
        wbForm.Close
        Set wbForm = Nothing
        Set wsForm = Nothing
   Next

End With

End Sub

.Find和每個表的單獨復制/粘貼循環是否在正確的軌道上？ 我意識到這是一個復雜的問題，感謝您抽出寶貴時間來幫助我。

Answer 1

.Find和每個表的單獨復制/粘貼循環是否在正確的軌道上？

不完全是。 這些循環內的代碼基本相同，因此是子例程的理想選擇。 這將使您的代碼更易於閱讀，並且維護起來也更容易，因為只有一個地方可以進行修訂，而不是多個地方（想象一下，如果您需要進行10次不同的迭代或1,000次，那么您就不會可能編寫1,000個不同的循環來執行相同的操作！！）

可以考慮一下（我觀察到一些會糾正的明顯錯誤，但這未經測試）。 我所做的就是將您的多個循環合並到一個子例程中。 然后，我們向該子例程發送一些信息，例如表的開始和結束位置：

Sub CopyStuff(ws as Worksheet, tblStart as Long, tblEnd as Long)

我們將發送它： wsSource ，並將使用/重復使用其他變量來確定每個表的開始/結束。 我刪除了多余的變量（除非它們需要在其他地方重復使用，沒有兩個變量EndOne和EndTwo是不必要的：我們可以利用tblStart和tblEnd類的通用變量，可以將它們重新分配給后續表。

通過這種方式，很明顯我們以相同的方式處理多個表。 如果將來需要更改代碼，則也只有一個For i = ...循環可以管理。 因此，它更易於理解和維護。

Sub CopyToForm()

    Dim wbSource As Workbook 'No longer needed in this context: wbForm As Workbook
    Dim wsSource As Worksheet 'No longer needed in this context: wsForm As Worksheet
    Dim formpath As String, foldertosavepath As String
    Dim tblEnd As Long, tblStart As Long, i As Integer
    Dim strProcessingFormPath As String
    Dim tblStart as Integer: tblStart = 16

    Set wbSource = ThisWorkbook '~~> Write your code in Indication Tool.xls
    Set wsSource = wbSource.Sheets("Indication Tool") '~~> Put the source sheet name

    With wsSource
        '~~> Counts how many rows are in the Indication Tool
        tblEnd = .Range("B" & .Rows.Count).End(xlUp).Row
        If tblEnd < 17 Then GoTo EarlyExit  '## I like to use only one exit point from my subroutines/functions

            CopyStuff wsSource, tblStart, tblEnd

        tblStart = .Range("B:B").Find("SecondTable").Row + 1
        tblEnd = .Range("B" & .Rows.Count).End(xlUp).Row

            CopyStuff wsSource, tblStart, tblEnd

        'And presumably...
        tblStart = .Range("B:B").Find("ThirdTable").Row + 1
        tblEnd = .Range("B" & .Rows.Count).End(xlUp).Row  

            CopyStuff wsSource, tblStart, tblEnd

    End With

    Exit Sub

EarlyExit:
    MsgBox "No data for transfer"

End Sub

Private Sub CopyStuff(ws As Worksheet, tblStart as Long, tblEnd as Long)
Dim wbForm as Workbook, wsForm as Worksheet, i As Long
With ws
For i = tblStart to tblEnd
    Set wbForm = Workbooks.Open(formpath) '~~> open the form
    Set wsForm = wbForm.Sheets("Processing Form") '~~> Declare which worksheet to activate
    '~~> Proceed with the copying / pasting of values
    .Range("B" & i).Copy wsForm.Range("F7:K7")
    .Range("C" & i).Copy: wsForm.Range("D8").PasteSpecial xlPasteValues
    .Range("C" & i).Copy: wsForm.Range("D30").PasteSpecial xlPasteValues
    .Range("D" & i).Copy: wsForm.Range("H29").PasteSpecial xlPasteValues
    .Range("E" & i).Copy: wsForm.Range("E29").PasteSpecial xlPasteValues
    .Range("F" & i).Copy: wsForm.Range("D33").PasteSpecial xlPasteValues
    .Range("G" & i).Copy: wsForm.Range("K30").PasteSpecial xlPasteValues
    .Range("H" & i).Copy: wsForm.Range("P33").PasteSpecial xlPasteValues
    .Range("L" & i).Copy: wsForm.Range("H32").PasteSpecial xlPasteValues
    .Range("R" & i).Copy: wsForm.Range("D87").PasteSpecial xlPasteValues
    '.Range("C5:M5").Copy: wsForm.Range("E102").PasteSpecial xlPasteValues
    '~~> Save the form using the value in cell i,B
    wbForm.SaveAs .Range("B" & i).Value & ".xls"
    wbForm.Close
    Set wbForm = Nothing
    Set wsForm = Nothing
Next
End With
End Sub