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