CODEWITHSUNDEEP
excelrangevba
Luu nguyen
Luu nguyen

Reputation: 157

Select and Copy multiple ranges with VBA

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

Upvotes: 2

Views: 27520

Answers (4)

Luu nguyen
Luu nguyen

Reputation: 157

 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

Upvotes: 0

Duc Anh Nguyen
Duc Anh Nguyen

Reputation: 128

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

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))

Upvotes: 3

Shai Rado
Shai Rado

Reputation: 33682

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.

Upvotes: 7

M_Idrees
M_Idrees

Reputation: 2172

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

Upvotes: 1

Related Questions