HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS

E

Eddy Stan

Hi,
I tried with Mike's code (multiple file question) given below, it works for
a fixed range and for the 1st sheet of workbook.
But I want to combine advance(sheet1),deposits(sheet2), creditors(sheet3),
so on...Sheet names are unique. Validation must be done at h column starting
row 6 for value & grab the row until value = "LLINE" or BLANK, similarly it
should check value in g column for deposit sheet, i column in prepaid sheet,
& so on... The consol file should have data for each sheet from all files (in
their respective sheets advance, deposit,..).
Hope I explained... Can any one modify his code to check sheet names, cell
values & help me.. thanks in advance.
I am using excel 2002.

Mike's code:
Sub DAC_Report()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim SourceRcount As Long
Dim N As Long
Dim rnum As Long
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant

SaveDriveDir = CurDir
'MyPath = "C:\Data"
'ChDrive MyPath
'ChDir MyPath
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls),
*.xls", _
MultiSelect:=True)
If IsArray(FName) Then
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
rnum = 1
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet

For N = LBound(FName) To UBound(FName)
Set mybook = Workbooks.Open(FName(N))
Set sourceRange = mybook.Worksheets(1).Range("A3:F53")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

basebook.Worksheets(1).Cells(rnum, "G").Value = mybook.Name
' This will add the workbook name in column D if you want

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
Next
End If
Columns("G:G").Font.Size = 8
Columns("G:G").Font.Bold = True
' ChDrive SaveDriveDir
' ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub


Eddy Stan
 
E

Eddy Stan

I checked, but there is no criteria checking to grab particulars row...

Can any one modify the mike's code, please....
 
E

Eddy Stan

Since my data is local, I tried with the example1_more_sheets().
Changed the path / range from a1:j1 to a1:s500
It worked but grabbed all data to one sheet (as said in example). But my
requirement is to combine all sheet1s, sheet2s, sheet3s....
See - advance (sheet1) is of one format, deposit (sheet2) is of different
format, creditors (sheet3) is one format, and so on.. I cannot use if
everything come to one sheet. Further data will not be there in all sheets so
we need to check some value in each row of a column until it finds "LLINE"
(last line).

I said mike's formula is working, but it has no criteria check, either value
or "LLINE", so I got struck there. My problem is a typical one I know... can
u something about it please..
 
E

Eddy Stan

Further to add...

I put mike's code in different sheet, it works as I changed worksheet number
1,2,3 so on... Can this be automated ??
Set sourceRange = mybook.Worksheets(3).Range("A6:S500")

Problem is that if one unit doesn't have deposits, they might delete the
sheet. As combining is done based on sheet numbers, it will colapse my plan
to consolidate subject wise (advance, deposit, statutory, etc.,) If data
grabbing is done by checking sheet names & data existence in each row then it
will be what I am expecting. I can hard code sheet names / if you cannot pick
& check the sheet names. Sheet names are unique. Can you find some solution.

ask me if you have doubt.. or can I send my files, (just 3 files).
 
R

Ron de Bruin

Hi Eddy

You can loop through the sheets after you open mybook
I use the index in this example but you can also use a array with sheet names
and test if the sheet name exist.

This example use the first two sheets (For a = 1 To 2)

Copy the sub and function in workbook with at least two sheets
Try this example first and post back

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim a As Integer

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.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)
For a = 1 To 2
Set sourceRange = mybook.Worksheets(a).Range("A1:C1")
rnum = LastRow(basebook.Worksheets(a)) + 1
Set destrange = basebook.Worksheets(a).Cells(rnum, "A")

sourceRange.Copy destrange
Next a

mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
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
 
E

Eddy Stan

Hi Ron,
It worked well with 12 sheets (for 77 files in my folder).
The only problem is that some locations have deleted some sheets like
advance / deposits/ fixed assets, where they dont have data. I have no
control over those guys. Only thing I can do is to check their file mannually
and insert dummy sheets for the deleted ones, as the procedure works with
sheet numbers. Opening 77 files to check the required sheets are existing &
in the order I provided (template) is a big hectic job.
If I can check the sheet name in the input file (or take 1st sheet in the
input file) compare the sheet name with my consol book for the sheet with the
same name then pull data to that sheet, then I am doing really a perfect job.
However tour thro' all links till 6:30 pm helped me lot for other
requirements. But still I stand where I was at 11 am today.
Just one more thought :
if I can assign commandbuttons 1 to 12 for my requirements - advance,
deposits, fixed assets, etc.,
when I click advance button, it should pull data from all 77 files only
advance sheets (if they exist) and consolidate in myworkbook in advance
sheet, that will be perfect.
Am I greedy to ask this !! kindly help me out..
Thanks again for your time & the code.
 
R

Ron de Bruin

Hi Eddy

Next step

Fill the array with sheet names
Shname = Array("Sheet1", "Sheet2")

And in the workbook with the code be sure that you have also sheets with that name
This example test if the workbook exist in the workbook you open in the loop ( see the function below the macro)

Sub Example1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim Shname As Variant
Dim N As Integer
Dim str As String

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath

FNames = Dir("*.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
Shname = Array("Sheet1", "Sheet2")

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
For N = LBound(Shname) To UBound(Shname)
str = Shname(N)
If SheetExists(str, mybook) Then
Set sourceRange = mybook.Worksheets(Shname(N)).Range("A1:C1")
rnum = LastRow(basebook.Worksheets(Shname(N))) + 1
Set destrange = basebook.Worksheets(Shname(N)).Cells(rnum, "A")
sourceRange.Copy destrange
End If
Next N

mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
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


Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function
 
E

Eddy Stan

Hi Ron,
It worked perfectly !
Almost a week's job you reduced it to 3 secs, I can do all petty fine tunings.

One more thing...
In my master workbook I want to have top 5 rows in all the sheets, not
disturbed and all combing should be done from row 6. Those rows are for
common title and I already bring data from a6: from all input files.

thanks for all the support.
Eddy Stan
 
R

Ron de Bruin

Hi Eddy

In all the sheets in the Master workbook first add the data titles in the first 5 rows.
The function look for the first empty row in each sheet, so if there is data in row 5 it copy the first info in row 6
 
E

Eddy Stan

Hi Ron,
Thanks for all the support. Now everything is working fine.
I have put the codes commandbuttons 1-To Clear 2-Pull data.
Sent the files to regional heads, so that they can do consol quickly. Now
they will have time to review data.

Next I want to consolidate columns, where columns
a-Code, b-account head c-debit and d-credit ( A & B) are constant while c /
d will change for 77 units (it is trial balance). data rows are from 4 to 550.
Let me work with your site / samples. I will come if have doubts.

thanks you once again.

Eddy Stan.
 

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

Similar Threads

Copy Multiple Workbooks to Worksheet 2
opening order macro for files in a folder 1
Macro Help Needed: Compiling data from multiple sheets and then transposing it during the paste. 2
Copy from fixed range does not work 6
CSE formulas in vba(ie: averageif in Excel 2003) 1
Merge 2 workbooks into 1 0
Extract data from many workbooks VBA 11
VBA code for pasting links -- modifying RDB code for summary workbook 11

Top