View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
 
Posts: 3,872
Default Open four Wbooks, copy four columns from each to Master Wbook

Hi Howard,

Am Mon, 2 Dec 2013 04:12:42 -0800 (PST) schrieb Howard:

I'll need to make some notes to myself on that, plus some study time.


with a second loop the code will be more compact:

Sub MondayMornCopy3()

Dim LRow As Long 'Last row
Dim varCol As Variant 'Array of columns
Dim varOut As Variant 'Array of data
Dim copyArr As Variant 'Array of workbooks
Dim i As Long 'Counter for workbook array
Dim j As Integer 'Counter for columns array

Const myPath = "C:\Users\Howard Kittle\Documents\"
copyArr = Array("Idaho", "Montana", "Wyoming", "Nebraska")
varCol = Array(1, 4, 6, 10)

Application.ScreenUpdating = False

For i = LBound(copyArr) To UBound(copyArr)
Workbooks.Open myPath & copyArr(i) & ".xlsm"
With ActiveWorkbook.Sheets("Sheet1")
For j = LBound(varCol) To UBound(varCol)
LRow = .Cells(.Rows.Count, varCol(j)).End(xlUp).Row
varOut = .Range(.Cells(1, varCol(j)), .Cells(LRow, varCol(j)))
Workbooks("Master.xlsm").Sheets("Sheet1") _
.Cells(Rows.Count, varCol(j)).End(xlUp)(2) _
.Resize(rowsize:=LRow) = varOut
Next j
ActiveWorkbook.Close savechanges:=True
End With
Next i
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2