suresh ullanki
Board Regular
- Joined
- Apr 29, 2013
- Messages
- 67
Hi,
I need to copy data from one workbook to another workbook. but macro will be run from third workbook. The following code is throwing an error saying subscript out of range. Can somebody help
Private Sub CommandButton1_Click() ' macro is run from command button from other workbook
Dim GetFile As Variant
MsgBox "Please select Source File and Target File"
GetFile = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open The Workbook", MultiSelect:=True)
On Error Resume Next
If GetFile <> False Then
On Error GoTo 0
For j = 1 To UBound(GetFile)
Workbooks.Open Filename:=GetFile(j) 'two workbooks will be opened here,
Next j
End If
Dim lastrow As Long, wkb As Workbook, ws1 As Worksheet, ws2 As Worksheet 'Total three workbooks are present now
Dim i As Long
Set ws2 = ThisWorkbook.Sheets("Format") ' Target workbook
Set wkb = ActiveWorkbook ' Source Workbook,This Workbook name will be changing every month. Hence given active workbook
Set ws1 = wkb.Sheets("Headcount Reg")
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
lastrow = ws1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To ws1.UsedRange.Columns.Count
Select Case i
Case Is <= 6
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i)
Case 8 To 14
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i - 1)
End Select
End Sub
I need to copy data from one workbook to another workbook. but macro will be run from third workbook. The following code is throwing an error saying subscript out of range. Can somebody help
Private Sub CommandButton1_Click() ' macro is run from command button from other workbook
Dim GetFile As Variant
MsgBox "Please select Source File and Target File"
GetFile = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open The Workbook", MultiSelect:=True)
On Error Resume Next
If GetFile <> False Then
On Error GoTo 0
For j = 1 To UBound(GetFile)
Workbooks.Open Filename:=GetFile(j) 'two workbooks will be opened here,
Next j
End If
Dim lastrow As Long, wkb As Workbook, ws1 As Worksheet, ws2 As Worksheet 'Total three workbooks are present now
Dim i As Long
Set ws2 = ThisWorkbook.Sheets("Format") ' Target workbook
Set wkb = ActiveWorkbook ' Source Workbook,This Workbook name will be changing every month. Hence given active workbook
Set ws1 = wkb.Sheets("Headcount Reg")
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
lastrow = ws1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To ws1.UsedRange.Columns.Count
Select Case i
Case Is <= 6
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i)
Case 8 To 14
Range(ws1.Cells(2, i), ws1.Cells(lastrow, i)).Copy Destination:=ws2.Cells(2, i - 1)
End Select
End Sub