Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine multiple books into one list
Hi All
I am very novice at VBA. I only know how to record macros and then modify them to do what I need. Using Excel 2002. I am trying to combine data from multiple (about 100) workbooks into one vertical list in a different workbook. Each workbook has a sheet named "IO" with four values I want to copy (cells B2:E2) plus the name of the workbook in cell A1. The resulting list would look like this: A B C D E 1 WorkbookName1 Value1 Value2 Value3 Value4 2 WorkbookName2 Value1 Value2 Value3 Value4 3 etc... I've copied someone's macro that will cycle through the workbooks in a directory and copy the cells I need. The only thing that I can't do is figure out how to paste it in the next empty row. I am sure this is an easy question, just not sure of the code. Here is what I have so far: Sub RegionList() Dim FileList() As String Dim Counter As Long Dim NextFile As String Dim thisfile As String Dim DirToSearch As String DirToSearch = "C:\Documents and Settings\User1\My Documents\CBAs\" Counter = 0 NextFile = Dir(DirToSearch & "\" & "*.xls") Do Until NextFile = "" ReDim Preserve FileList(Counter) FileList(Counter) = DirToSearch & "\" & NextFile Counter = Counter + 1 NextFile = Dir() Loop Application.Calculation = xlManual On Error Resume Next For Counter = LBound(FileList) To UBound(FileList) 'MsgBox FileList(Counter) Workbooks.Open Filename:=FileList(Counter) ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Co unt).Name = thisfile Windows(thisfile).Activate Sheets("IO").Select Range("A1").Select Selection.Copy Windows("NewBook.xls").Activate 'this is open to the correct sheet Range("A1").Select 'this is where I need it to select the next blank row in column A and paste Windows(thisfile).Activate Sheets("IO").Select Range("B2:E2").Select Selection.Copy Windows("NewBook.xls").Activate Range("B1").Select 'this is where I need it to select the cell in column B next to the workbook name that I just pasted Windows(thisfile).Activate ActiveWorkbook.Save Workbooks(thisfile).Close Next Application.Calculation = xlAutomatic End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine multiple books into one list
Use the following
Range("A65536").End(xlUp).Offset(1, 0).Select "Steve Mackay" wrote in message om... Hi All I am very novice at VBA. I only know how to record macros and then modify them to do what I need. Using Excel 2002. I am trying to combine data from multiple (about 100) workbooks into one vertical list in a different workbook. Each workbook has a sheet named "IO" with four values I want to copy (cells B2:E2) plus the name of the workbook in cell A1. The resulting list would look like this: A B C D E 1 WorkbookName1 Value1 Value2 Value3 Value4 2 WorkbookName2 Value1 Value2 Value3 Value4 3 etc... I've copied someone's macro that will cycle through the workbooks in a directory and copy the cells I need. The only thing that I can't do is figure out how to paste it in the next empty row. I am sure this is an easy question, just not sure of the code. Here is what I have so far: Sub RegionList() Dim FileList() As String Dim Counter As Long Dim NextFile As String Dim thisfile As String Dim DirToSearch As String DirToSearch = "C:\Documents and Settings\User1\My Documents\CBAs\" Counter = 0 NextFile = Dir(DirToSearch & "\" & "*.xls") Do Until NextFile = "" ReDim Preserve FileList(Counter) FileList(Counter) = DirToSearch & "\" & NextFile Counter = Counter + 1 NextFile = Dir() Loop Application.Calculation = xlManual On Error Resume Next For Counter = LBound(FileList) To UBound(FileList) 'MsgBox FileList(Counter) Workbooks.Open Filename:=FileList(Counter) ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Co unt).Name = thisfile Windows(thisfile).Activate Sheets("IO").Select Range("A1").Select Selection.Copy Windows("NewBook.xls").Activate 'this is open to the correct sheet Range("A1").Select 'this is where I need it to select the next blank row in column A and paste Windows(thisfile).Activate Sheets("IO").Select Range("B2:E2").Select Selection.Copy Windows("NewBook.xls").Activate Range("B1").Select 'this is where I need it to select the cell in column B next to the workbook name that I just pasted Windows(thisfile).Activate ActiveWorkbook.Save Workbooks(thisfile).Close Next Application.Calculation = xlAutomatic End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine multiple books into one list
I was kind of confused, but maybe this'll give you some ideas. It uses a nice
function from Chip Pearson to check to see if a worksheet exists. Option Explicit Sub RegionList2() Dim FileList() As String Dim Counter As Long Dim NextFile As String Dim DirToSearch As String Dim nextWkbk As Workbook Dim ToWks As Worksheet Dim oRow As Long 'DirToSearch = "C:\Documents and Settings\User1\My Documents\CBAs\" DirToSearch = "C:\my documents\excel\test\" Counter = 0 NextFile = Dir(DirToSearch & "\" & "*.xls") Do Until NextFile = "" ReDim Preserve FileList(Counter) FileList(Counter) = DirToSearch & "\" & NextFile Counter = Counter + 1 NextFile = Dir() Loop If Counter = 0 Then 'no files found Exit Sub End If 'I wasn't sure where you were putting the results 'so I made a new sheet Set ToWks = ThisWorkbook.Worksheets.Add ToWks.Range("a1").Resize(1, 5).Value _ = Array("name", "B2", "C2", "D2", "E2") oRow = 1 Application.Calculation = xlManual 'maybe you won't need the on error statement?? 'On Error Resume Next For Counter = LBound(FileList) To UBound(FileList) 'MsgBox FileList(Counter) Set nextWkbk = Workbooks.Open(Filename:=FileList(Counter)) If WorksheetExists("IO", nextWkbk) Then oRow = oRow + 1 ToWks.Cells(oRow, "A").Value _ = nextWkbk.Worksheets("IO").Range("A1").Value ToWks.Cells(oRow, "B").Resize(1, 4).Value _ = nextWkbk.Worksheets("Io").Range("b2:e2").Value End If nextWkbk.Close savechanges:=False Next Counter 'thisworkbook.save Application.Calculation = xlAutomatic End Sub Function WorksheetExists(SheetName As String, _ Optional WhichBook As Workbook) As Boolean 'from Chip Pearson Dim WB As Workbook Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook) On Error Resume Next WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) 0) End Function Steve Mackay wrote: Hi All I am very novice at VBA. I only know how to record macros and then modify them to do what I need. Using Excel 2002. I am trying to combine data from multiple (about 100) workbooks into one vertical list in a different workbook. Each workbook has a sheet named "IO" with four values I want to copy (cells B2:E2) plus the name of the workbook in cell A1. The resulting list would look like this: A B C D E 1 WorkbookName1 Value1 Value2 Value3 Value4 2 WorkbookName2 Value1 Value2 Value3 Value4 3 etc... I've copied someone's macro that will cycle through the workbooks in a directory and copy the cells I need. The only thing that I can't do is figure out how to paste it in the next empty row. I am sure this is an easy question, just not sure of the code. Here is what I have so far: Sub RegionList() Dim FileList() As String Dim Counter As Long Dim NextFile As String Dim thisfile As String Dim DirToSearch As String DirToSearch = "C:\Documents and Settings\User1\My Documents\CBAs\" Counter = 0 NextFile = Dir(DirToSearch & "\" & "*.xls") Do Until NextFile = "" ReDim Preserve FileList(Counter) FileList(Counter) = DirToSearch & "\" & NextFile Counter = Counter + 1 NextFile = Dir() Loop Application.Calculation = xlManual On Error Resume Next For Counter = LBound(FileList) To UBound(FileList) 'MsgBox FileList(Counter) Workbooks.Open Filename:=FileList(Counter) ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Co unt).Name = thisfile Windows(thisfile).Activate Sheets("IO").Select Range("A1").Select Selection.Copy Windows("NewBook.xls").Activate 'this is open to the correct sheet Range("A1").Select 'this is where I need it to select the next blank row in column A and paste Windows(thisfile).Activate Sheets("IO").Select Range("B2:E2").Select Selection.Copy Windows("NewBook.xls").Activate Range("B1").Select 'this is where I need it to select the cell in column B next to the workbook name that I just pasted Windows(thisfile).Activate ActiveWorkbook.Save Workbooks(thisfile).Close Next Application.Calculation = xlAutomatic End Sub -- Dave Peterson |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine multiple books into one list
Thanks, Greg. That's exactly what I was looking for.
Steve Mackay "Greg Koppel" wrote in message ... Use the following Range("A65536").End(xlUp).Offset(1, 0).Select "Steve Mackay" wrote in message om... Hi All I am very novice at VBA. I only know how to record macros and then modify them to do what I need. Using Excel 2002. I am trying to combine data from multiple (about 100) workbooks into one vertical list in a different workbook. Each workbook has a sheet named "IO" with four values I want to copy (cells B2:E2) plus the name of the workbook in cell A1. The resulting list would look like this: A B C D E 1 WorkbookName1 Value1 Value2 Value3 Value4 2 WorkbookName2 Value1 Value2 Value3 Value4 3 etc... I've copied someone's macro that will cycle through the workbooks in a directory and copy the cells I need. The only thing that I can't do is figure out how to paste it in the next empty row. I am sure this is an easy question, just not sure of the code. Here is what I have so far: Sub RegionList() Dim FileList() As String Dim Counter As Long Dim NextFile As String Dim thisfile As String Dim DirToSearch As String DirToSearch = "C:\Documents and Settings\User1\My Documents\CBAs\" Counter = 0 NextFile = Dir(DirToSearch & "\" & "*.xls") Do Until NextFile = "" ReDim Preserve FileList(Counter) FileList(Counter) = DirToSearch & "\" & NextFile Counter = Counter + 1 NextFile = Dir() Loop Application.Calculation = xlManual On Error Resume Next For Counter = LBound(FileList) To UBound(FileList) 'MsgBox FileList(Counter) Workbooks.Open Filename:=FileList(Counter) ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Co unt).Name = thisfile Windows(thisfile).Activate Sheets("IO").Select Range("A1").Select Selection.Copy Windows("NewBook.xls").Activate 'this is open to the correct sheet Range("A1").Select 'this is where I need it to select the next blank row in column A and paste Windows(thisfile).Activate Sheets("IO").Select Range("B2:E2").Select Selection.Copy Windows("NewBook.xls").Activate Range("B1").Select 'this is where I need it to select the cell in column B next to the workbook name that I just pasted Windows(thisfile).Activate ActiveWorkbook.Save Workbooks(thisfile).Close Next Application.Calculation = xlAutomatic End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine multiple books into one list
Thanks for the help, Dave. Sorry for the confusion...I think I had left a
line out and had another one that I didn't need. Here is the final code and it works great. Sub RegionList() Dim FileList() As String Dim Counter As Long Dim NextFile As String Dim thisfile As String Dim DirToSearch As String DirToSearch = "C:\Documents and Settings\User1\My Documents\CBAs" Counter = 0 NextFile = Dir(DirToSearch & "\" & "*.xls") Do Until NextFile = "" ReDim Preserve FileList(Counter) FileList(Counter) = DirToSearch & "\" & NextFile Counter = Counter + 1 NextFile = Dir() Loop Application.Calculation = xlManual On Error Resume Next For Counter = LBound(FileList) To UBound(FileList) Workbooks.Open Filename:=FileList(Counter) thisfile = ActiveWorkbook.Name 'Paste Name Windows(thisfile).Activate Sheets("IO").Select Range("A1").Select Selection.Copy Windows("NewBook.xls").Activate Range("A65536").End(xlUp).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 'Paste Investment Values Windows(thisfile).Activate Sheets("CBA Template").Select Range("B2:E2").Select Selection.Copy Windows("NewBook.xls").Activate Range("B65536").End(xlUp).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Workbooks(thisfile).Saved = True Workbooks(thisfile).Close Next Application.Calculation = xlAutomatic End Sub Steve Mackay "Dave Peterson" wrote in message ... I was kind of confused, but maybe this'll give you some ideas. It uses a nice function from Chip Pearson to check to see if a worksheet exists. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Viewing multiple books | Excel Discussion (Misc queries) | |||
multiple sheets 2 work books | Excel Worksheet Functions | |||
Large Project with multiple books | Excel Discussion (Misc queries) | |||
Viewing multiple books | Excel Discussion (Misc queries) | |||
How can I enter an online list of library books into Excell's Boo. | Setting up and Configuration of Excel |