Copying from several workbooks into one

A

Anthony Gobel

From the suggestion of a friend, I looked in here for an example to help me with a problem. I found one posted a couple of days ago by Dave Peterson. It seems to work great, but I am looking for some assistance to make a slight modification. I know excel well, but not VBA. Right now it looks like this is looking into a specific folder to get file names. What I would like to be able to do is make it look on a sheet in a specific column and get the file names to combine from there. Say for instance the file names are listed in column "E". Is there a way to make this code look in column "E", and use all the files listed there instead of a specific folder

Option Explici
Sub CombineWorkbooks(
Dim LastRow As Lon
Dim basebook As Workboo
Dim i As Lon
Dim mybook As Workboo
Dim DestCell As Rang
Dim RngToCopy As Rang

With Applicatio
.DisplayAlerts = Fals
.EnableEvents = Fals
.ScreenUpdating = Fals
End Wit
With Application.FileSearc
.NewSearc
'Change this to your director
.LookIn = ThisWorkbook.Path & "\ProgramData\"
.SearchSubFolders = Fals
.FileType = msoFileTypeExcelWorkbook
If .Execute() > 0 The
Set basebook = Workbooks.Open(.FoundFiles(1))
With basebook.Worksheets(1
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp
End With
For i = 2 To .FoundFiles.Coun
Set mybook = Workbooks.Open(.FoundFiles(i)
With ActiveShee
'column R = 18th colum
Set RngToCopy = .Range("a1:R" &
.Cells(.Rows.Count, "A").End(xlUp).Row
End With
If (DestCell.Row + RngToCopy.Rows.Count)
< DestCell.Parent.Rows.Count The
'ok to paste, just come down one
Set DestCell = DestCell.Offset(1, 0
Els
'too many rows, make a new shee
Set DestCell = basebook.Worksheets.Add.Range("a1"
End If
RngToCopy.Copy
Destination:=DestCel
Set DestCell = DestCell.Offset(RngToCopy.Rows.Count)
mybook.Clos
Next
'ChDir ThisWorkbook.Path & "\ProgramData\FileData\Report\
ActiveWorkbook.SaveAs
Filename:=ThisWorkbook.Path & "\ProgramData\FileData\Report\"
& "Report1.xls",
FileFormat:=xlNormal, CreateBackup:=Fals
'ActiveWorkbook.Close savechanges:=false 'just save
End I
End Wit
With Applicatio
.DisplayAlerts = Tru
.EnableEvents = Tru
End Wit
End Su

I don't really know if this is something that can be done or not, but if anybody has any ideas, it would be very helpful

Anthony
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top