Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Merge Multiple Workbooks
Hi,
Wonder if someone acn help me please. I am using, and have been for sometime some great coding below, (admitedly not mine, a great programmer called Ken Wright) to copy rows of data from multiple workbooks and pasting them into one master sheet. The macro also copies the header of the first workbook it extracts the data from and ignores the headers in the rest. Sub CopyFromMultipleFiles() Dim lrow As Long Dim Hdrs As Long Dim NumCols As Long Dim ffc As Long Dim i As Long Dim R As Integer Dim WBn As String Dim rng As Range Dim WB As Workbook Dim WBr As Range Dim WBlstrw As Long Dim CurWkb As Workbook Dim CurWks As Worksheet Dim CurWksLrow As Long Dim strStartDir As String Dim UserFile As String Dim Sht As Worksheet On Error Resume Next UserFile = PickFolder(strStartDir) If UserFile = "" Then MsgBox "Canceled" Exit Sub End If Set CurWkb = Workbooks.Add 'CurWks will always refer to the Summary worksheet you are creating Set CurWks = CurWkb.Worksheets(1) Application.ScreenUpdating = False 'Clear out the Summary worksheet With CurWks .Activate .UsedRange.Delete End With lrow = 1 Hdrs = 1 With Application.FileSearch .SearchSubFolders = True .NewSearch .Filename = ".xls" .LookIn = UserFile .FileType = msoFileTypeExcelWorkbooks .Execute ffc = .FoundFiles.Count For i = 1 To ffc 'WB will always refer to the source Workbook that 'you are interrogating at the time Set WB = Application.Workbooks.Open(Filename:=.FoundFiles(i )) If i = 1 Then NumCols = WB.Sheets(1).UsedRange.Column - 1 + _ WB.Sheets(1).UsedRange.Columns.Count CurWks.Cells(Hdrs, "A").Resize(1, NumCols).Value = _ WB.Worksheets(1).Range("A1").Resize(1, NumCols).Value End If Application.StatusBar = "Currently Processing file " & i & " of " & ffc WBn = WB.Name WBlstrw = WB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row 'Copy the data across CurWks.Cells(lrow + 1, "A").Resize(WBlstrw - Hdrs, NumCols).Value = _ WB.Worksheets(1).Range("A2").Resize(WBlstrw - Hdrs, NumCols).Value ' 'Put the filename in the first Col as an index value ' CurWks.Cells(lrow + 1, "A").Resize(WBlstrw - Hdrs, 1).Value = WBn lrow = lrow + (WBlstrw - Hdrs) WB.Close savechanges:=False Next End With Set WB = Nothing Set CurWks = Nothing Set CurWkb = Nothing Application.ScreenUpdating = True Application.StatusBar = False End Sub The problem I have is that the files I get containing the data I extract have changed. The above macro assumes that there is always data in the A column and uses this as a guide to copy the data within the whole row. This is now not always the case. With my very limited VB knowledge, by changing things around, adding and removing the code I think I've located the line that needs to change as this: 'WBlstrw = WB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row' I am fairly new to VB and not that confident and I've tried to change the Cells(Row to Range, but this doesn't work. Could somebody tell me please how I could change the code so it looks at a range rather than column A. Many thanks and regards Chris |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Completely Merge Multiple Workbooks? | Excel Discussion (Misc queries) | |||
Merge workbooks | Excel Discussion (Misc queries) | |||
merge workbooks | Excel Worksheet Functions | |||
Trying to Merge 2 Workbooks | Excel Discussion (Misc queries) | |||
Merge Workbooks? | Excel Programming |