VBA to merge multiple workbooks with demarcation

Pls, I need help on how to merge multiple excel workbooks into single worksheet but with demarcation. I mean I want to know where one workbook data starts and ends, preferably filling the entire first column with workbook name.
What this mean is that as each workbook is copying to the new worksheet, it will pick its workbook name and use it to fill entire first column in the new worksheet and do that to all workbooks.
I had tried the code below before but I was not able to know where one workbook data starts and ends. And I need that knowledge to be able to proceed with further analysis.

Code:

---

Sub Button2_Click()

Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer

RowofCopySheet = 2 ' Row to start on in the sheets you are copying from

ThisWB = ActiveWorkbook.Name

path = GetDirectory("Select a folder containing Excel files you want to merge")

Application.EnableEvents = False
Application.ScreenUpdating = False

Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest
Wkb.Close False
End If

Filename = Dir()
Loop

Range("A1").Select

Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox "Done!"
End Sub

---

Thanks alot

Code:

---

With Wkb.Sheets(1).UsedRange
    Set CopyRng = Intersect(.Cells, .Offset(RowofCopySheet - 1))
End With
Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Dest.Resize(CopyRng .Rows.Count).Value = Filename
CopyRng.Copy Dest.Offset(, 1)

---

Thanks alot. I will try it and get back.

Pls the expert, I am to use this script together with my own. I mean the one that merge multiple workbooks into single one. Or it use it alone.
It is as if I am not getting it. Thanks

Code:

---

Sub Button2_Click()
Dim Wkb As Workbook
Dim wbDest As Workbook, shtDest As Worksheet, source As Worksheet
Dim path As String, ThisWB As String, Filename As String
Dim CopyRng As Range, Dest As Range
Dim currLastrow As Long, prevlastrow As Long
   
    On Error GoTo err_exit
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    currLastrow = 2 ' Row to start on in the sheets you are copying from
   
    ThisWB = ActiveWorkbook.Name
    Set shtDest = ActiveWorkbook.Sheets(1)
   
    path = GetDirectory("Select a folder containing Excel files you want to merge")
   
    Filename = Dir(path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
   
    Do Until Filename = vbNullString
   
        If Not Filename = ThisWB Then
       
            Set Wkb = Workbooks.Open(Filename:=path & "" & Filename)
            Set source = Wkb.Sheets(1)
            Set CopyRng = source.Range(source.Cells(currLastrow, 1), source.Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
           
            Dest = shtDest.Range("B" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
            CopyRng.Copy Dest
           
            Wkb.Close False
           
            prevlastrow = currLastrow
            currLastrow = shtDest.Cells(shdest.Rows.Count, "B").End(xlUp).Row
            shdest.Cells(prevlastrow, "A").Resize(currLastrow - prevlastrow + 1).Value = Filename
        End If
       
        Filename = Dir()
    Loop
   
    shdest.Range("A1").Select
   
    Application.EnableEvents = True
    Application.ScreenUpdating = True
   
    MsgBox "Done!"
   
    Exit Sub

GoTo err_exit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

---

[QUOTE=Bob Phillips;409868][CODE]Sub Button2_Click()
Dim Wkb As Workbook
Dim wbDest As Workbook, shtDest As Worksheet, source As Worksheet
Dim path As String, ThisWB As String, Filename As String
Dim CopyRng As Range, Dest As Range
Dim currLastrow As Long, prevlastrow As Long

On Error GoTo err_exit
Application.EnableEvents = False
Application.ScreenUpdating = False

currLastrow = 2 ' Row to start on in the sheets you are copying from

ThisWB = ActiveWorkbook.Name
Set shtDest = ActiveWorkbook.Sheets(1)

path = GetDirectory("Select a folder containing Excel files you want to merge")

Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub

Do Until Filename = vbNullString

If Not Filename = ThisWB Then

Set Wkb = Workbooks.Open(Filename:=path & "" & Filename)
Set source = Wkb.Sheets(1)
Set CopyRng = source.Range(source.Cells(currLastrow, 1), source.Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))

Dest = shtDest.Range("B" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
CopyRng.Copy Dest

Wkb.Close False

prevlastrow = currLastrow
currLastrow = shtDest.Cells(shdest.Rows.Count, "B").End(xlUp).Row
shdest.Cells(prevlastrow, "A").Resize(currLastrow - prevlastrow + 1).Value = Filename
End If

Filename = Dir()
Loop

shdest.Range("A1").Select

Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox "Done!"

Exit Sub

GoTo err_exit:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


Pls expert, can you help me check this code again. It is not running at all. I will click run, it will just fail to run and not doing anything. You yourself can try it. Thanks

Pls expert, can you help me check this code again. It is not running at all. I will click run, it will just fail to run and not doing anything. You yourself can try it. Thanks

Pls, there is compile error: Label not defined
Thanks

Sorry, my error

Code:

---

Sub Button2_Click()
Dim Wkb As Workbook
Dim wbDest As Workbook, shtDest As Worksheet, source As Worksheet
Dim path As String, ThisWB As String, Filename As String
Dim CopyRng As Range, Dest As Range
Dim currLastrow As Long, prevlastrow As Long
   
    On Error GoTo err_exit
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    currLastrow = 2 ' Row to start on in the sheets you are copying from
   
    ThisWB = ActiveWorkbook.Name
    Set shtDest = ActiveWorkbook.Sheets(1)
   
    path = GetDirectory("Select a folder containing Excel files you want to merge")
   
    Filename = Dir(path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
   
    Do Until Filename = vbNullString
   
        If Not Filename = ThisWB Then
       
            Set Wkb = Workbooks.Open(Filename:=path & "" & Filename)
            Set source = Wkb.Sheets(1)
            Set CopyRng = source.Range(source.Cells(currLastrow, 1), source.Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
           
            Dest = shtDest.Range("B" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
            CopyRng.Copy Dest
           
            Wkb.Close False
           
            prevlastrow = currLastrow
            currLastrow = shtDest.Cells(shdest.Rows.Count, "B").End(xlUp).Row
            shdest.Cells(prevlastrow, "A").Resize(currLastrow - prevlastrow + 1).Value = Filename
        End If
       
        Filename = Dir()
    Loop
   
    shdest.Range("A1").Select
   
    Application.EnableEvents = True
    Application.ScreenUpdating = True
   
    MsgBox "Done!"
   
    Exit Sub

err_exit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

---

@akin

Have you got any VBA knowledge ?