Combining Files

[Guest]

I got this code from google. It almost does exactly what I need but there is one problem. What I have is in a direstiry I have a number of files, I won't know their names or how many of them, but they are all organized the same way. They each only have one sheet. I need to take all of the files and combine them into one file on one sheet. The problem is some of the columns are empty, however none of the rows are. So my data is continuious by row but not by column. This code copies all of the data in column A onto one sheet but since column B is empty it doesn't get the data from C or D. Is there anyway to change this code to make it work in this situation. (As a side note if this helps, I will know that column R is the last one with data in it.)

Sub Consolidate()
With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = ThisWorkbook.Path & "\Files\Data\"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set basebook = Workbooks.Open(.FoundFiles(1))
For i = 2 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
Range("A1").CurrentRegion.Copy _
basebook.Worksheets(1).Range("a1").End(xlDown).Offset(1, 0)
mybook.Close
Next i
basebook.SaveAs _
Application.GetSaveAsFilename("Consolidated file.xls")
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With


End Sub

I would appreciate any help or advice that anyone can give me on this.

 

[Mike Fogleman]

Since column B is empty, your line

Range("A1").CurrentRegion.Copy _
basebook.Worksheets(1).Range("a1").End(xlDown).Offset(1, 0)

is failing with .CurrentRegion because it lacks contiguous data. Use a
RowCount on Range("A1").CurrentRegion and then copy Range("A1:R" & RowCount)

I got this code from google. It almost does exactly what I need but there

is one problem. What I have is in a direstiry I have a number of files, I
won't know their names or how many of them, but they are all organized the
same way. They each only have one sheet. I need to take all of the files
and combine them into one file on one sheet. The problem is some of the
columns are empty, however none of the rows are. So my data is continuious
by row but not by column. This code copies all of the data in column A onto
one sheet but since column B is empty it doesn't get the data from C or D.
Is there anyway to change this code to make it work in this situation. (As
a side note if this helps, I will know that column R is the last one with
data in it.)

 

[Dave Peterson]

It looks like column A is always used in each row of each workbook (else you
have trouble with the xldown line).

So you can use that fact and just base the range to copy on that:
Option Explicit
Sub Consolidate()

Dim LastRow As Long
Dim baseBook As Workbook
Dim i As Long
Dim myBook As Workbook

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = ThisWorkbook.Path & "\Files\Data\"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set baseBook = Workbooks.Open(.FoundFiles(1))
For i = 2 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("a1").Resize(LastRow, 18).Copy _
baseBook.Worksheets(1).Range("a1").End(xlDown).Offset(1, 0)
End With
myBook.Close
Next i
baseBook.SaveAs _
Application.GetSaveAsFilename("Consolidated file.xls")
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub


(I didn't test it, but it did compile ok.)

 

[Guest]

Thanks alot, it works perfectly, and saves me a whole lot of copy-and-paste.

Thanks for all the help

RJ

 

[Guest]

Having one last slight problem - every time the macro runs it pops up the save as window - how do I make it jsut save and not show this window.

Thanks for any further help

RJ

----- Dave Peterson wrote: -----

It looks like column A is always used in each row of each workbook (else you
have trouble with the xldown line).

So you can use that fact and just base the range to copy on that:
Option Explicit
Sub Consolidate()

Dim LastRow As Long
Dim baseBook As Workbook
Dim i As Long
Dim myBook As Workbook

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Change this to your directory
.LookIn = ThisWorkbook.Path & "\Files\Data\"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set baseBook = Workbooks.Open(.FoundFiles(1))
For i = 2 To .FoundFiles.Count
Set myBook = Workbooks.Open(.FoundFiles(i))
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("a1").Resize(LastRow, 18).Copy _
baseBook.Worksheets(1).Range("a1").End(xlDown).Offset(1, 0)
End With
myBook.Close
Next i
baseBook.SaveAs _
Application.GetSaveAsFilename("Consolidated file.xls")
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub


(I didn't test it, but it did compile ok.)

 

[Dave Peterson]

I thought you saved the basebook as new name on purpose.

This line:
baseBook.SaveAs _
Application.GetSaveAsFilename("Consolidated file.xls")

can be replaced with just:
baseBook.Save

But you're doing a lot of work. I've never trusted things that much. I'm
afraid that I'll mess up my original workbook.