Select and Copy multiple ranges with VBA - excel

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