Question

我正致力于将各种工作表复制并粘贴到中心位置＆＃34;导入＆＃34;工作簿中的选项卡。这些床单都是模板，有些已经填写，有些则没有。无论如何，因为细胞是由模板填充的，所以永远不会有真正的空白＆＃34;片。我想只引入已添加的数据（超出模板）。如果没有添加数据，则源最后一行= 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

或者只是在＆lt; 12 check and resume

之后跳出来

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

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

1 个答案: