尝试使用Excel VBA跳过复制/粘贴循环中的空白行

Question

I have a copy / paste loop for line items in an Excel file that exports data from these line items into an Excel-based form and saves each form by the value in Row B. My issue is that these line items are divided into 3 different tables on the same sheet, each with a different number of line items to be copied. Furthermore, each table is separated by 2 blank rows.

What I need the macro to do for me:

1. Start at line 17 and copy all line items in the first table until it hits a blank row - this varies from 1 to 600 rows.
2. Skip to SecondTable and perform the same functions.
3. Repeat for ThirdTable

Ignore some of the declarations as I deleted a large chunk of code for readability. I figured I would need 3 separate copy/paste loops to accomplish this (I've only included 2 here) and I tried using .Find to reference the start of the second/third tables. The macro runs as normal through the first table, but doesn't stop when it hits a blank row and fails when it tries to save a file based on the value of an empty cell. I believe the issue lies with the EndOne = .Range("B" & .Rows.Count).End(xlUp).Row argument right under With wsSource . Instead of counting only the non-blank rows of the first table, it counts the number of rows through the end of the third table.

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

Am I on the right track with the .Find and a separate copy/paste loop for each table? I realize this is a complex problem and I appreciate any time you take to spend helping me out.

Answer 1

Am I on the right track with the .Find and a separate copy/paste loop for each table?

Not exactly. The code inside those loops is largely the same, so it is a good candidate for subroutine. This will make your code more human-readable, and also makes it easier to maintain since there will only be one place to make revisions, instead of multiple (imagine if you needed to do 10 different iterations, or 1,000 -- you wouldn't possibly write 1,000 different loops to do the same thing!!)

Consider this instead (I observe a few obvious errors which I will correct, but this is not tested). What I have done is to take your several loops, and consolidate them in to a single subroutine. Then we send some information like where the table starts and where it ends, to that subroutine:

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

We will send it: wsSource , and the other variables will be used/re-used to determine the start/end of each table. I removed the redundant variables (unless they need to be re-used elsewhere, having two variables EndOne and EndTwo is unnecessary: we can make use of more generic variables like tblStart and tblEnd which we can reassign for subsequent tables.

In this way it is a lot more apparent that we are processing multiple tables in an identical manner. We also have only a single For i = ... loop to manage, should the code require changes in the future. So it is easier to comprehend, and easier to maintain.

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