VBA - 如果最后一行不等于则复制

Question

我正在将各种工作表复制并粘贴到工作簿中的中央“导入”选项卡中。每张表格都是一个模板，有些已经填写，有些则没有。无论如何，因为单元格是由模板填充的，所以从来没有真正的“空”表。我只想引入已添加的数据(超出模板)。如果没有添加数据，源最后一行 = 11。如果 lrs=11，我如何最好地修改我的代码以不复制工作表(但如果 lrs > 11 则复制数据)，然后转到下一张工作表?

For i = 1 To Sheets.Count
    If Sheets(i).Name <> "Import" And Sheets(i).Name <> "Cover page" And Sheets(i).Name <> "Introduction" And Sheets(i).Name <> "Additional Fuels" Then
        With Sheets(i)
            lrs = .Cells(.Rows.Count, "S").End(xlUp).Row 'Column S = "Specific Claim Language"
            .Range(.Cells(11, "B"), .Cells(lrs, "U")).Copy 'Data of interest exists from B to U
        End With
        With Sheets("Import")
            lrd = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range(.Cells(lrd + 1, "A"), .Cells(lrd + 1 + lrs, "AA")).PasteSpecial xlValues 'Only pasting data relevant to columns B:U on source, A:T on destination
        End With
    End If
Next i

Answer 1

只需检查 lrs复制前大于 11，粘贴前也一样。

Option Explicit
Sub test()
    For i = 1 To Sheets.count
        If Sheets(i).Name <> "Import" And Sheets(i).Name <> "Cover page" And Sheets(i).Name <> "Introduction" And Sheets(i).Name <> "Additional Fuels" Then
            With Sheets(i)
                lrs = .Cells(.Rows.count, "S").End(xlUp).Row 'Column S = "Specific Claim Language"
                If lrs > 11 Then
                    .Range(.Cells(11, "B"), .Cells(lrs, "U")).Copy 'Data of interest exists from B to U
                End if
            End With
            If lrs > 11 Then
                With Sheets("Import")
                    lrd = .Cells(.Rows.count, "A").End(xlUp).Row
                    .Range(.Cells(lrd + 1, "A"), .Cells(lrd + 1 + lrs, "AA")).PasteSpecial xlValues 'Only pasting data relevant to columns B:U on source, A:T on destination
                End With
            End If
        End If
    Next i 
End Sub

或者只是在<12检查后跳出并恢复

Option Explicit
Sub test()
    For i = 1 To Sheets.count
        If Sheets(i).Name <> "Import" And Sheets(i).Name <> "Cover page" And Sheets(i).Name <> "Introduction" And Sheets(i).Name <> "Additional Fuels" Then
            With Sheets(i)
                lrs = .Cells(.Rows.count, "S").End(xlUp).Row 'Column S = "Specific Claim Language"
                If lrs < 12 Then GoTo nextsheet:
                .Range(.Cells(11, "B"), .Cells(lrs, "U")).Copy 'Data of interest exists from B to U
            End With
            With Sheets("Import")
                lrd = .Cells(.Rows.count, "A").End(xlUp).Row
                .Range(.Cells(lrd + 1, "A"), .Cells(lrd + 1 + lrs, "AA")).PasteSpecial xlValues 'Only pasting data relevant to columns B:U on source, A:T on destination
            End With
        End If
nextsheet:
    resume nextsheet2:
nextsheet2:
    Next i 
End Sub