Select and Copy multiple ranges with VBA

Question

I want to copy multiple range to another workbook. I have the code below. How can I replace the number 1000 by iLastRow

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

Answer 1

Try the code below, explanation inside the code as comments:

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

Another question is how you want to paste the merged reanges that have a gap in the middle.

Answer 2

The Union method is a solution to this problem. but it also has its cons

The union range should be the same first row and last row. On the other hand, you can just select the first cell to paste. you can alway do like this. the main point here is the row number should be the same. here I synchronize both range with the same variable. in your case, change to last cell.

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

Answer 3

Change Range params from this:

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

To:

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

Since with multiple selection Copy will not work. You may need to call it twice in your case. (as per suggestion by @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