LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 45
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Completely Merge Multiple Workbooks? Daystrom Excel Discussion (Misc queries) 0 March 30th 09 06:33 PM
Merge workbooks Bonnie Excel Discussion (Misc queries) 1 October 29th 07 11:50 PM
merge workbooks FYF Excel Worksheet Functions 2 December 13th 06 06:50 PM
Trying to Merge 2 Workbooks Anne Excel Discussion (Misc queries) 2 July 18th 06 08:28 PM
Merge Workbooks? AD108 Excel Programming 0 December 14th 05 07:29 PM


All times are GMT +1. The time now is 09:59 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"