使用VBA

Question

我想将多个范围复制到另一个工作簿。我有下面的代码。如何用iLastRow替换数字1000

iLastRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
sh.Range("A3:AG1000, AL3:EJ1000").Select
Selection.Copy

Answer 1

尝试下面的代码，代码中的解释为注释：

Option Explicit

Sub CopyMultipleRanges()

Dim iLastRow As Long
Dim sh As Worksheet
Dim MultiRng As Range

Set sh = ThisWorkbook.Worksheets("Sheet1") ' <-- change to your sheet's name
With sh
    iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

    ' use the union to set a range combined from multiple ranges
    Set MultiRng = Union(.Range("A3:A" & iLastRow), .Range("AL3:EJ" & iLastRow))
End With

' copy the range, there's no need to select it first
MultiRng.Copy

End Sub

另一个问题是你想如何粘贴中间有间隙的合并复制品。

Answer 2

Union方法是解决此问题的方法。但它也有其缺点

联合范围应该是第一行和最后一行。 另一方面，您可以选择要粘贴的第一个单元格。 你总能做到这一点。这里的要点是行号应该是一样的。在这里，我将两个范围与同一个变量同步。在您的情况下，更改为最后一个单元格。

j=1
i = 4
Set MultiRng = Union(Range("A" & j & ":B" & i), Range("D" & j & ":E" & i))

Answer 3

改变范围参数：

iLastRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
sh.Range("A3:AG1000, AL3:EJ1000").Select

要：

iLastRow = Sh.Range("B" & Rows.Count).End(xlUp).Row
sh.Range("A3:AG" & iLastrow &", AL3:EJ" & iLastRow).Select

由于多次选择Copy不起作用。在您的情况下，您可能需要两次调用它。 （根据@ YowE3K的建议）

sh.Range("A3:AG" & iLastrow).Select
Selection.Copy

sh.Range("AL3:EJ" & iLastrow).Select
Selection.Copy

Answer 4

 Option Explicit

    Sub import_APVP()

        Dim master As Worksheet, sh As Worksheet
        Dim wk As Workbook
        Dim strFolderPath As String
        Dim selectedFiles As Variant
        Dim iFileNum As Integer, iLastRowReport As Integer, iNumberOfRowsToPaste As Integer
        Dim strFileName As String
        Dim iCurrentLastRow As Integer, iRowStartToPaste As Integer
        Dim MultiRng As Range
        Dim startTime As Double

        getSpeed (True)
        Set master = ActiveWorkbook.ActiveSheet

        strFolderPath = ActiveWorkbook.Path

        ChDrive strFolderPath
        ChDir strFolderPath
        Application.ScreenUpdating = False
        'On Error GoTo NoFileSelected
        selectedFiles = Application.GetOpenFilename( _
                        filefilter:="Excel Files (*.xls*),*.xlsx*", MultiSelect:=True)
        For iFileNum = LBound(selectedFiles) To UBound(selectedFiles)
            strFileName = selectedFiles(iFileNum)

            Set wk = Workbooks.Open(strFileName)

            For Each sh In wk.Sheets
                If sh.Name Like "DATA*" Then
                    With sh
                        iLastRowReport = .Range("D" & .Rows.Count).End(xlUp).Row
                        iNumberOfRowsToPaste = iLastRowReport + 2 - 1

                       '.Range("A3:AG" & iLastRowReport & " , AL3:EJ & iLastRowReport").Select
                       ' Selection.Copy
                        Set MultiRng = Union(.Range("A3:AG" & iLastRowReport), .Range("AL3:EJ" & iLastRowReport))
'you delete the 3 in range ("AL:EJ....) that make your code not work.
                        MultiRng.Copy
                        With master
                            iCurrentLastRow = .Range("B" & .Rows.Count).End(xlUp).Row
                            iRowStartToPaste = iCurrentLastRow + 1

                            '.Activate ' <-- not needed
                              .Range("A" & iRowStartToPaste).PasteSpecial xlPasteAll
                             'ActiveSheet.Paste <-- not needed

                        End With

                    End With
                End If
            Next sh
            wk.Close
        Next
        getSpeed (False)

        Application.ScreenUpdating = True

    NoFileSelected:

    End Sub