I have the following code to copy a range from one workbook into another. I wasnt to amend it to copy multipel ranges , but im not great with VBA and dont know how to amend it to do so. The ranges I need are (A:C, E:E, G:H)
Sub GetData_Example5()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant, N As Long
Dim rnum As Long, destrange As Range
Dim sh As Worksheet
SaveDriveDir = CurDir
MyPath = "O:\SupplyChain\Purchasing\High & Why" 'or use "C:\Data"
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*", _
MultiSelect:=True)
If IsArray(FName) Then
' Sort the Array
FName = Array_Sort(FName)
Application.ScreenUpdating = False
'Add worksheet to the Activeworkbook and use the Date/Time as name
Set sh = ActiveWorkbook.Worksheets.Add
sh.Name = Format(Now, "dd-mm-yy h-mm-ss")
'Loop through all files you select in the GetOpenFilename dialog
For N = LBound(FName) To UBound(FName)
'Find the last row with data
rnum = LastRow(sh)
'create the destination cell address
Set destrange = sh.Cells(rnum + 1, "A")
' For testing Copy the workbook name in Column E
sh.Cells(rnum + 1, "E").Value = FName(N)
'Get the cell values and copy it in the destrange
'Change the Sheet name and range as you like
GetData FName(N), "Sheet1", "A:C", destrange, False, False
Next
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
Sub GetData_Example5()
Dim SaveDriveDir As String, MyPath As String
Dim FName As Variant, N As Long
Dim rnum As Long, destrange As Range
Dim sh As Worksheet
SaveDriveDir = CurDir
MyPath = "O:\SupplyChain\Purchasing\High & Why" 'or use "C:\Data"
ChDrive MyPath
ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files,*.xl*", _
MultiSelect:=True)
If IsArray(FName) Then
' Sort the Array
FName = Array_Sort(FName)
Application.ScreenUpdating = False
'Add worksheet to the Activeworkbook and use the Date/Time as name
Set sh = ActiveWorkbook.Worksheets.Add
sh.Name = Format(Now, "dd-mm-yy h-mm-ss")
'Loop through all files you select in the GetOpenFilename dialog
For N = LBound(FName) To UBound(FName)
'Find the last row with data
rnum = LastRow(sh)
'create the destination cell address
Set destrange = sh.Cells(rnum + 1, "A")
' For testing Copy the workbook name in Column E
sh.Cells(rnum + 1, "E").Value = FName(N)
'Get the cell values and copy it in the destrange
'Change the Sheet name and range as you like
GetData FName(N), "Sheet1", "A:C", destrange, False, False
Next
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub