View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Howard Howard is offline
external usenet poster
 
Posts: 536
Default Open four Wbooks, copy four columns from each to Master Wbook

Code seems to be okay until the first copy line which errors out in yellow.

Opens the four "state named" workbooks okay.

This line, one line up from error line shows lCol4 = 10 when cursor is hovered over it, which is correct.

Set rangeJ = Range("J1:J" & lCol4)

Is my syntax wrong with the copy lines?

Thanks.
Howard


Option Explicit

Sub MondayMornCopy()

'Idaho, Montana, Wyoming, Nebraska
Dim Idaho As Workbook, Montana As Workbook, Wyoming As Workbook, Nebraska As Workbook
Dim lCol1 As Long, lCol2 As Long, lCol3 As Long, lCol4 As Long
Dim rangeA As Range, rangeD As Range, rangeF As Range, rangeJ As Range
Dim copyArr As Variant
Dim i As Long

Workbooks.Open Filename:= _
"C:\Users\Howard Kittle\Documents\Idaho.xlsm"
Workbooks.Open Filename:= _
"C:\Users\Howard Kittle\Documents\Montana.xlsm"
Workbooks.Open Filename:= _
"C:\Users\Howard Kittle\Documents\Wyoming.xlsm"
Workbooks.Open Filename:= _
"C:\Users\Howard Kittle\Documents\Nebraska.xlsm"

lCol1 = Cells(Rows.Count, 1).End(xlUp).Row
lCol2 = Cells(Rows.Count, 4).End(xlUp).Row
lCol3 = Cells(Rows.Count, 6).End(xlUp).Row
lCol4 = Cells(Rows.Count, 10).End(xlUp).Row

Application.ScreenUpdating = False

copyArr = Array(Idaho, Montana, Wyoming, Nebraska)
For i = LBound(copyArr) To UBound(copyArr)

With copyArr(i)
Set rangeA = Range("A1:A" & lCol1)
Set rangeD = Range("D1:D" & lCol2)
Set rangeF = Range("F1:F" & lCol3)
Set rangeJ = Range("J1:J" & lCol4)

Workbooks("Master.xlsm").Sheets("Sheet1").Range("A " & Rows.Count).End(xlUp)(2) = copyArr(i).rangeA
Workbooks("Master.xlsm").Sheets("Sheet1").Range("D " & Rows.Count).End(xlUp)(2) = copyArr(i).rangeD
Workbooks("Master.xlsm").Sheets("Sheet1").Range("F " & Rows.Count).End(xlUp)(2) = copyArr(i).rangeF
Workbooks("Master.xlsm").Sheets("Sheet1").Range("J " & Rows.Count).End(xlUp)(2) = copyArr(i).rangeJ

copyArr(i).Save
copyArr(i).Close
End With

Next
Application.ScreenUpdating = True
End Sub