Help combine workbooks into 1

[RompStar]

Hi there

My first real post here :- )

Ok, on my local network \\

I have 5 different Excel.xls documents,

appendfile-doc.xls
appendfile-doc.xls
appendfile-doc.xls
appendfile-doc.xls
appendfile-doc.xls

there the part -doc.xls is different for each document...

in each document there is a single sheet, each one names differently and of course I know their names...

EAch doc is exactly the same in desigh, has 4 columns, A, B, C, D

A: has Department Name
B: has Date
C: has Employee Name
D: Daily Status

A11 has headers (see above) and everything below that starting at

A22 is data...

So, there are 5 different documents, I simply want to merge them all into a single sheet, keep the headers and paste the data... only select data filled, ignore blank rows below last used...

I need to do this everyday.... so manual cut and paste takes a good 10 minutes and I don't want to waste my time, as I have so many things to do plus since I am learning VBA, I would like to learn how to do this for other things I am sure I will have to do...

So I guess I need a VBA script that will go and grab these files from the network and paste them into a Master Append document that holds them all in a single sheet...

That's my goal for now :- )

All the files that I want start with:

appendfile-*.xls so that's why I referenced it like that... so I need to grab all those workbook sheets and transfer them over to a single sheet, not individual sheet in a new workbook, any ideas ?

I tried to use this script that I found on your network...: I tried to use \*\ so it look in all the folders in that path, but I don't think that work, does that mean I have to spell out all 5 paths ?

Option Explicit
 
Sub CombineFiles()
Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
Path = \\local\network\path\*\
FileName = Dir(Path & "\appendfile-*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

I'll buy u a beer if you help me :- )

[mdmackillop]

Hi RompStar,
Welcome to VBAX
If you can zip up and post a copy of your files, it would help us to help you. To attach files, use the Go Advanced tbutton below the message box, and at the bottom of that screen, use Manage Attachments to upload your file.
Regards
MD

[RompStar]

Ok, here it is:

They all look the same, format that is, the data might be different...

I just want to combine them all into a single sheet, not a different workbook for each import sheet...

did it work ?

was trying to post the HTML, but I guess that doesn't work

[mdmackillop]

Zip your 5 files together then use Manage Attachments.

[RompStar]

alright, I uploaded the zip file, the rest of the 4 files look exactly the same, they might have more data in them... so I need to be able to ignore Last Row that's empty...

Keep in mind that these individual files grow in size everyday, because information is appended to them on a daily basis, I just want to merge them all on a daily basis too...

Later I will try to figure out how to check for only new data and add it to the Master append, but for now I think this goal is good enough, I can just clear the mater and run it again to have it updated.

[RompStar]

what about code like this, trying to make the With Application.FileSearch to make it work, but I am a little bit stuck.. here is the code:

can anybody help me out to complete it ?

Option Explicit 

Sub MergeFiles()
Dim basebook As Workbook ' The current open book that files will be merged into
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim lrow As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
SaveDriveDir = CurDir
With Application.FileSearch
.NewSearch
.LookIn = \\local\net\work
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
' ChDrive MyPath
' ChDir MyPath
FNames = .LookIn
FNames = Dir("appendfile-*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet
rnum = 1
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
lrow = LastRow(mybook.Sheets(1))
Set sourceRange = mybook.Worksheets(1).Range("A2:IV" & lrow)
'Copy from A2:IV? (till the last row with data on your sheet)
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")
sourceRange.Copy destrange
' Instead of this line you can use the code below to copy only the values
' With sourceRange
' Set destrange = basebook.Worksheets(1).Cells(rnum, "A"). _
' Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value
mybook.Close False
rnum = rnum + SourceRcount
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
End With
Application.ScreenUpdating = True
End Sub
 
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
after:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

[mdmackillop]

Have a look at the attached. It collects the file names locations differently, looking through a folder and sub-folders for the file names (don't know if this is required), and then extracts the data, basically using your own code. It's a bit untidy, but no more time just now. Extract the attached into C:\Apath to test.

Option Explicit
Option Compare Text
 
Sub GetData()
Dim BaseBook As Workbook ' The current open book that files will be merged into
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim lrow As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyFiles, F
Const MyPath = "C:\APath" ' Set the path.
Const FileName = "AppendFile" & "*.xls"
Set BaseBook = ThisWorkbook
MyFiles = ProcessFiles(MyPath, FileName, -1)
rnum = 1
For Each F In MyFiles
If F = "" Then Exit Sub
Set mybook = Workbooks.Open(F)
lrow = Range("A" & Cells.Rows.Count).End(xlUp).Row
Set sourceRange = mybook.Worksheets(1).Range("A2:IV" & lrow)
'Copy from A2:IV? (till the last row with data on your sheet)
SourceRcount = sourceRange.Rows.Count
Set destrange = BaseBook.Worksheets(1).Cells(rnum, "A")
sourceRange.Copy destrange
mybook.Close False
rnum = rnum + SourceRcount
Next
End Sub
 
 
Function ProcessFiles(strFolder As String, strFilePattern As String, Optional j As Long) As Variant
Dim strFileName As String
Dim strFolders() As String
Dim iFolderCount As Integer
Dim I As Long
Static strFiles(5) As String
'Collect child folders
strFileName = Dir$(strFolder & "\", vbDirectory)
Do Until strFileName = ""
If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then
If Left$(strFileName, 1) <> "." Then
ReDim Preserve strFolders(iFolderCount)
strFolders(iFolderCount) = strFolder & "\" & strFileName
iFolderCount = iFolderCount + 1
End If
End If
strFileName = Dir$()
Loop
'process files in current folder
strFileName = Dir$(strFolder & "\" & strFilePattern)
Do Until strFileName = ""
If Right(strFileName, 3) = "xls" Then
j = j + 1
'Do things with files here
strFiles(j) = strFolder & "\" & strFileName
End If
strFileName = Dir$()
Loop
'Look through child folders
For I = 0 To iFolderCount - 1
ProcessFiles strFolders(I), strFilePattern, j
Next I
ProcessFiles = strFiles
End Function

[RompStar]

Thanks for replying, and taking the time to help me out, I sincerely appreciate the time you took out of your personal time to help me out..


I'll roll a fatty just for u.

and celebrate after work

hahaha

Ok, now time to test this code. I am reading books, but sometimes new information can hurt this head, so I have to take breaks, but I notice that everytime I look at it, it hurts less and less...



Alright, thank you.