EXCEL VBA challenge . how to merge workbooks into one

I'm logging off now but here's some code that you could edit for your task:

Sub PasteBase(): Dim wb As Workbook, ws As Worksheet, wd As Worksheet, r As Long
Dim s As String, p As String, U As String: p = ActiveWorkbook.path & "\": U = Dir(p)

'Unless you know the Path for these files you'll need to have one of them up at invocation

For Each wb In Workbooks                 'If "Database" is open then Set receiving sheet
If wb.Name Like "Database.xls*" Then GoTo SetDB
Next: Workbooks.Open FileName:=p & "Database"  'Else open "Database"
SetDB: Set wd = Workbooks("Database").Sheets("Direct Personel"): r = 3
SetaBook:
If U Like "Database.xl*" Then GoTo GetaBook
If InStr(1, U, ".xl") = 0 Then GoTo GetaBook
If InStr(1, U, "Report") Then
Workbooks.Open FileName:=p & U, UpdateLinks:=0
Set wb = ActiveWorkbook: Set ws = wb.Sheets("Direct Personel")
ws.Range("A3:D59").Copy wd.Cells(r, 1): wb.Close SaveChanges:=False
r = r + 59: End If
GetaBook: U = Dir()
If U = "" Then Exit Sub
GoTo SetaBook: End Sub

in the meantime you could supply some more information - but it's best if you:

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic

I'll see what I can do tomorrow!

And, Thanks for the rep!

You're welcome!

Try this:

Sub PasteBase(): Dim wb As Workbook, ss As Worksheet, wm As Workbook, sm As Worksheet
Dim r As Long, c As Long, m As Long, P As String, U As String
P = "C:\MyFiles\": U = Dir(P):Set wm = Workbooks("MASTER MERGED")
SetaBook:
If U Like "MASTER*" Then GoTo GetaBook
If InStr(1, U, ".xl") = 0 Then GoTo GetaBook
If InStr(1, U, "COMPANY") Then
Workbooks.Open Filename:=P & U, UpdateLinks:=0: Set wb = ActiveWorkbook
                        For Each ss In wb.Worksheets
                        For Each sm In wm.Worksheets
                        If ss.Name = sm.Name Then GoTo GetLimits
                        Next sm
     wm.Worksheets.Add(After:=wm.Worksheets(wm.Worksheets.Count)).Name = ss.Name
                        
                        
GetLimits:  Set sm = wm.Sheets(ss.Name)
            r = ss.Range("A:A").Find("*", , , , xlByRows, xlPrevious).Row
            c = ss.Rows(1).Find("*", , , , xlByColumns, xlPrevious).Column
            If sm.Range("A1") = "" Then m = 2 Else _
            m = sm.Range("A:A").Find("*", , , , xlByRows, xlPrevious).Row + 1
            If m < 3 Then ss.Rows(1).Copy sm.Cells(1, 1)
            ss.UsedRange.Offset(1).Copy sm.Cells(m, 1)
            sm.Cells(m, c + 1).Resize(r - 1, 1) = wb.Name
Next ss: End If: wb.Close SaveChanges:=False

GetaBook: U = Dir()
If U = "" Then Exit Sub


GoTo SetaBook: End Sub

Hi,

The sample file you sent was named "MASTER MERGED" - you must have that file with that name open since that's where you wanted the code to be.

The colons allow me to put more than one line of code on a line i.e.

P = "C:\MyFiles\": U = Dir(P): Set wm = Workbooks("MASTER MERGED")

would, otherwise, need to be written as:

P = "C:\MyFiles\"
 U = Dir(P)
Set wm = Workbooks("MASTER MERGED")

Here's your file - try running it from this

The colon and the underscore are used differently:

The underscore is a line continuation while the colon makes a new line in the code

Glad you got it working - I didn't need the extension on my system

Hi Top,

Did you have:

U = Dir(P)

somewhere before the

U = Dir()

?

Hi Top,

Start another thread and give a link to it here then:

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and use the paperclip icon to open the upload window.

View Pic