Sir Babydum GBE
09-09-2007, 05:46 AM
Hi,
Firstly, I'm going on annual leave when I finish today, so I hope you don't mind but I'm going to post this question in VBAX and MrExcel, as I'm hoping to get this piece finished before i go.
The purpose of the following code is to open up excel documents within the same folders as the coded document is sitting, then to copy information from those documents to itself.
I would like to amend this now but am not sure how.
My intention is to have a sheet entitled "Sources", then in column A, have a list of folder paths. So instead of just examining documents in the same folder - I want the macro to look at my list of sources, and then open all Excel workbooks that are in the folders I have indicated in that list.
How should the code be modified?
strPath = ThisWorkbook.Path
If strPath = "" Then
MsgBox "This workbook must be saved in directory first!"
Exit Sub
End If
Application.ScreenUpdating = False
strPath = strPath & Application.PathSeparator
strFile = Dir(strPath & "*.xls")
Set wksDest = ActiveSheet
lngTargRow = 3
Do Until strFile = ""
If Not strFile = ThisWorkbook.Name Then
Set wbk = Workbooks.Open(strPath & strFile, UpdateLinks:=0)
Set wksSource = wbk.Sheets(3)
If LCase$(wksSource.Cells(1, 1).Value) = "userworkbook" Then
Set rngLastCell = LastCellInSheet(wksSource)
If rngLastCell.Row > 2 Then
With wksSource
varData = .Range(.Cells(3, "A"), rngLastCell)
End With
lngRowCount = UBound(varData, 1)
lngColumnCount = UBound(varData, 2)
With wksDest
.Range(.Cells(lngTargRow, 1), .Cells(lngTargRow + lngRowCount - 1, _
lngColumnCount)).Value = varData
End With
lngTargRow = lngTargRow + lngRowCount
End If
End If
wbk.Close False
End If
strFile = Dir
Loop
fldr = Split(ThisWorkbook.FullName, "\")
fldr = fldr(UBound(fldr) - 1)
Thanks a lot
BD
Firstly, I'm going on annual leave when I finish today, so I hope you don't mind but I'm going to post this question in VBAX and MrExcel, as I'm hoping to get this piece finished before i go.
The purpose of the following code is to open up excel documents within the same folders as the coded document is sitting, then to copy information from those documents to itself.
I would like to amend this now but am not sure how.
My intention is to have a sheet entitled "Sources", then in column A, have a list of folder paths. So instead of just examining documents in the same folder - I want the macro to look at my list of sources, and then open all Excel workbooks that are in the folders I have indicated in that list.
How should the code be modified?
strPath = ThisWorkbook.Path
If strPath = "" Then
MsgBox "This workbook must be saved in directory first!"
Exit Sub
End If
Application.ScreenUpdating = False
strPath = strPath & Application.PathSeparator
strFile = Dir(strPath & "*.xls")
Set wksDest = ActiveSheet
lngTargRow = 3
Do Until strFile = ""
If Not strFile = ThisWorkbook.Name Then
Set wbk = Workbooks.Open(strPath & strFile, UpdateLinks:=0)
Set wksSource = wbk.Sheets(3)
If LCase$(wksSource.Cells(1, 1).Value) = "userworkbook" Then
Set rngLastCell = LastCellInSheet(wksSource)
If rngLastCell.Row > 2 Then
With wksSource
varData = .Range(.Cells(3, "A"), rngLastCell)
End With
lngRowCount = UBound(varData, 1)
lngColumnCount = UBound(varData, 2)
With wksDest
.Range(.Cells(lngTargRow, 1), .Cells(lngTargRow + lngRowCount - 1, _
lngColumnCount)).Value = varData
End With
lngTargRow = lngTargRow + lngRowCount
End If
End If
wbk.Close False
End If
strFile = Dir
Loop
fldr = Split(ThisWorkbook.FullName, "\")
fldr = fldr(UBound(fldr) - 1)
Thanks a lot
BD