mcconnella
New Member
- Joined
- Jul 21, 2009
- Messages
- 4
I have some code here that is meant to copy data from three different workbooks and consolidate it in one worksheet in a new workbook.
Here's a sample of the first part of the code:
Sub AutoConsolidateDealStatus2()
'Specify the start row for the New Workbook
Dim d
d = 2
'Maximum Amount of rows to search through in each sheet, including the New Workbook
Dim MaxRows
MaxRows = 60000
'Specify the name of the new workbook
newWorkbookName = "DealStatus"
'Create new workbook
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="P:\Admin\Financials\2010\" & newWorkbookName & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'Write column headers in new workbook
Range("A1").Value = "Deal#"
Range("b1").Value = "Deal Status"
Range("c1").Value = "Firm Date"
Range("d1").Value = "Receipt/Received Date"
Range("e1").Value = "Property Address"
Range("f1").Value = "Vendor/Landlord#"
Range("g1").Value = "Purchaser/Tenant"
Range("h1").Value = "Associate"
Range("i1").Value = "Associate Commission"
Range("j1").Value = "Gross to Department"
'Copy Data from Pipeline workbook
currentWorkbook = "pipeline"
Workbooks.Open Filename:="P:\Admin\Financials\2010\Jan 25 Test\" & currentWorkbook & ".xls"
Windows(newWorkbookName).Activate
For i = 7 To MaxRows
If Not IsEmpty(Workbooks(currentWorkbook).Sheets("Sheet1").Range("A" & i)) Then
Range("A" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("D" & i) 'Deal Id
Range("B" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("B" & i) 'Deal Status
Range("D" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("C" & i) 'Expected Receipt Date/Received Date
Range("E" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("G" & i) 'Property Address
Range("F" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("H" & i) 'Vendor/Landlord
Range("G" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("I" & i) 'Purchaser/Tenant
Range("H" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("K" & i) 'Associate
Range("I" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("M" & i) 'Associate Commission
Range("J" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("N" & i) 'Gross to Department
d = d + 1
End If
Next i
I get an error everytime I run it at the Windows(newWorkbookName).Activate command. Subscript out of range error.
This code worked when I tested at home and now it's not working....can anyone help with why I'm getting the error.
Here's a sample of the first part of the code:
Sub AutoConsolidateDealStatus2()
'Specify the start row for the New Workbook
Dim d
d = 2
'Maximum Amount of rows to search through in each sheet, including the New Workbook
Dim MaxRows
MaxRows = 60000
'Specify the name of the new workbook
newWorkbookName = "DealStatus"
'Create new workbook
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="P:\Admin\Financials\2010\" & newWorkbookName & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'Write column headers in new workbook
Range("A1").Value = "Deal#"
Range("b1").Value = "Deal Status"
Range("c1").Value = "Firm Date"
Range("d1").Value = "Receipt/Received Date"
Range("e1").Value = "Property Address"
Range("f1").Value = "Vendor/Landlord#"
Range("g1").Value = "Purchaser/Tenant"
Range("h1").Value = "Associate"
Range("i1").Value = "Associate Commission"
Range("j1").Value = "Gross to Department"
'Copy Data from Pipeline workbook
currentWorkbook = "pipeline"
Workbooks.Open Filename:="P:\Admin\Financials\2010\Jan 25 Test\" & currentWorkbook & ".xls"
Windows(newWorkbookName).Activate
For i = 7 To MaxRows
If Not IsEmpty(Workbooks(currentWorkbook).Sheets("Sheet1").Range("A" & i)) Then
Range("A" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("D" & i) 'Deal Id
Range("B" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("B" & i) 'Deal Status
Range("D" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("C" & i) 'Expected Receipt Date/Received Date
Range("E" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("G" & i) 'Property Address
Range("F" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("H" & i) 'Vendor/Landlord
Range("G" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("I" & i) 'Purchaser/Tenant
Range("H" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("K" & i) 'Associate
Range("I" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("M" & i) 'Associate Commission
Range("J" & d).Value = Workbooks(currentWorkbook).Sheets("Sheet1").Range("N" & i) 'Gross to Department
d = d + 1
End If
Next i
I get an error everytime I run it at the Windows(newWorkbookName).Activate command. Subscript out of range error.
This code worked when I tested at home and now it's not working....can anyone help with why I'm getting the error.