Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
Start here
http://www.rondebruin.nl/copy3.htm Click on this link on that page http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
I checked, but there is no criteria checking to grab particulars row...
Can any one modify the mike's code, please.... "Ron de Bruin" wrote: Start here http://www.rondebruin.nl/copy3.htm Click on this link on that page http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
What have you try ?????
-- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... I checked, but there is no criteria checking to grab particulars row... Can any one modify the mike's code, please.... "Ron de Bruin" wrote: Start here http://www.rondebruin.nl/copy3.htm Click on this link on that page http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
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.. "Ron de Bruin" wrote: What have you try ????? -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... I checked, but there is no criteria checking to grab particulars row... Can any one modify the mike's code, please.... "Ron de Bruin" wrote: Start here http://www.rondebruin.nl/copy3.htm Click on this link on that page http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
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). "Ron de Bruin" wrote: What have you try ????? -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... I checked, but there is no criteria checking to grab particulars row... Can any one modify the mike's code, please.... "Ron de Bruin" wrote: Start here http://www.rondebruin.nl/copy3.htm Click on this link on that page http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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.. "Ron de Bruin" wrote: What have you try ????? -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... I checked, but there is no criteria checking to grab particulars row... Can any one modify the mike's code, please.... "Ron de Bruin" wrote: Start here http://www.rondebruin.nl/copy3.htm Click on this link on that page http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
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. "Ron de Bruin" wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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.. "Ron de Bruin" wrote: What have you try ????? -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... I checked, but there is no criteria checking to grab particulars row... Can any one modify the mike's code, please.... "Ron de Bruin" wrote: Start here http://www.rondebruin.nl/copy3.htm Click on this link on that page http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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. "Ron de Bruin" wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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.. "Ron de Bruin" wrote: What have you try ????? -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... I checked, but there is no criteria checking to grab particulars row... Can any one modify the mike's code, please.... "Ron de Bruin" wrote: Start here http://www.rondebruin.nl/copy3.htm Click on this link on that page http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
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 "Ron de Bruin" wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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. "Ron de Bruin" wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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.. "Ron de Bruin" wrote: What have you try ????? -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... I checked, but there is no criteria checking to grab particulars row... Can any one modify the mike's code, please.... "Ron de Bruin" wrote: Start here http://www.rondebruin.nl/copy3.htm Click on this link on that page http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 "Ron de Bruin" wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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. "Ron de Bruin" wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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.. "Ron de Bruin" wrote: What have you try ????? -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... I checked, but there is no criteria checking to grab particulars row... Can any one modify the mike's code, please.... "Ron de Bruin" wrote: Start here http://www.rondebruin.nl/copy3.htm Click on this link on that page http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
Hi Eddy
I add a example on my site for this also http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 "Ron de Bruin" wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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. "Ron de Bruin" wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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.. "Ron de Bruin" wrote: What have you try ????? -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... I checked, but there is no criteria checking to grab particulars row... Can any one modify the mike's code, please.... "Ron de Bruin" wrote: Start here http://www.rondebruin.nl/copy3.htm Click on this link on that page http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
HELP TO COMBINE MULTIPLE SHEETS IN MULTIPLE WORKBOOKS
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. "Ron de Bruin" wrote: Hi Eddy I add a example on my site for this also http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 "Ron de Bruin" wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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. "Ron de Bruin" wrote: 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 -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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.. "Ron de Bruin" wrote: What have you try ????? -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... I checked, but there is no criteria checking to grab particulars row... Can any one modify the mike's code, please.... "Ron de Bruin" wrote: Start here http://www.rondebruin.nl/copy3.htm Click on this link on that page http://www.rondebruin.nl/copy3tip.htm -- Regards Ron de Bruin http://www.rondebruin.nl "Eddy Stan" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Combine multiple workbooks into one workbook | Excel Discussion (Misc queries) | |||
Combine multiple workbooks into 1 workbook w/ multiple worksheets | Excel Discussion (Misc queries) | |||
Combine multiple workbooks into 1 workbook w/ multiple worksheets | Excel Discussion (Misc queries) | |||
Combine multiple workbooks into one workbook | Excel Discussion (Misc queries) | |||
Combine tabs from multiple workbooks into one | Excel Discussion (Misc queries) |