VBA to get file name

[Sammilynn]

I have made a VBA code to open the file explorer to select different files and copy a range and paste that range into a master file. I would like to grab the name of the file that got opened to copy from and place that next to the first line of data that was pasted into the master file. I will put the current code that I have wrote below.

Sub Get_Data_From_File()
Dim FiltToOpen As Variant
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long


Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*), *xls*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)

Set wsCopy = OpenBook.Worksheets("review")
Set wsDest = Workbooks("Pull Data Sheet 03282023").Worksheets("review")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
wsCopy.Range("A2:Q" & lCopyLastRow).Copy _
wsDest.Range("B" & lDestLastRow)


Set wsCopy = OpenBook.Worksheets("excluded")
Set wsDest = Workbooks("Pull Data Sheet 03282023").Worksheets("excluded")
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
wsCopy.Range("A2:Q" & lCopyLastRow).Copy _
wsDest.Range("B" & lDestLastRow)

OpenBook.Close False
End If
Application.ScreenUpdating = True
End Sub

 

[mumps]

Try:

Sub Get_Data_From_File()
    Application.ScreenUpdating = False
    Dim FileToOpen As Variant, ws As Worksheet, wsDest As Worksheet, OpenBook As Workbook, lRow As Long
    Set wsDest = ThisWorkbook.Sheets("review")
    lRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Row + 1
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*), *xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        wsDest.Range("A" & lRow) = OpenBook.Name
        For Each ws In Sheets(Array("review", "excluded"))
            With ws
                .Range("A2", .Range("Q" & .Rows.Count).End(xlUp)).Copy wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1)
            End With
        Next ws
        OpenBook.Close False
    End If
    Application.ScreenUpdating = True
End Sub

 

[Sammilynn]

This is kind of working. it is grabbing the file name but the original code was copying the review sheet and then pasting in the master review sheet then going back and copying the excluded sheet and pasting in the master excluded sheet. With the new code you added it is pasting everything on the review sheet. I attempted to just do two of the same code and just separate them and use this code but that did not work.

 

[mumps]

Try:

Sub Get_Data_From_File()
    Application.ScreenUpdating = False
    Dim FileToOpen As Variant, ws As Worksheet, wbDest As Workbook, OpenBook As Workbook, lRow As Long
    Set wbDest = ThisWorkbook
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*), *xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        For Each ws In Sheets(Array("review", "excluded"))
            With wbDest.Sheets(ws.Name)
                lRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
                .Range("A" & lRow) = OpenBook.Name
            End With
            With ws
                .Range("A2", .Range("Q" & .Rows.Count).End(xlUp)).Copy wbDest.Sheets(ws.Name).Cells(wbDest.Sheets(ws.Name).Rows.Count, "B").End(xlUp).Offset(1)
            End With
        Next ws
        OpenBook.Close False
    End If
    Application.ScreenUpdating = True
End Sub

 

[Sammilynn]

That worked! Thank you so much! Was wondering if there is an adjustment i could make so it does not grab the .xlsx at the end of the file name and just grabs the name?

 

[mumps]

Replace this line of code:

.Range("A" & lRow) = OpenBook.Name

with this line:

.Range("A" & lRow) = Split(OpenBook.Name, ".")(0)

 

[Sammilynn]

Great thank you so much!

 

[mumps]

You are very welcome.

 

[SamarthSalunkhe]

Try:

Sub Get_Data_From_File()
    Application.ScreenUpdating = False
    Dim FileToOpen As Variant, ws As Worksheet, wbDest As Workbook, OpenBook As Workbook, lRow As Long
    Set wbDest = ThisWorkbook
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*), *xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        For Each ws In Sheets(Array("review", "excluded"))
            With wbDest.Sheets(ws.Name)
                lRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
                .Range("A" & lRow) = OpenBook.Name
            End With
            With ws
                .Range("A2", .Range("Q" & .Rows.Count).End(xlUp)).Copy wbDest.Sheets(ws.Name).Cells(wbDest.Sheets(ws.Name).Rows.Count, "B").End(xlUp).Offset(1)
            End With
        Next ws
        OpenBook.Close False
    End If
    Application.ScreenUpdating = True
End Sub

Hi @mumps

Can you please add one more control here.

if user haven't select any file and cancel it, then code should give massage (Eg: please select file) or Ext Sub.

 

[mumps]

Try:

Sub Get_Data_From_File()
    Application.ScreenUpdating = False
    Dim FileToOpen As Variant, ws As Worksheet, wbDest As Workbook, OpenBook As Workbook, lRow As Long
    Set wbDest = ThisWorkbook
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*), *xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        For Each ws In Sheets(Array("review", "excluded"))
            With wbDest.Sheets(ws.Name)
                lRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
                .Range("A" & lRow) = OpenBook.Name
            End With
            With ws
                .Range("A2", .Range("Q" & .Rows.Count).End(xlUp)).Copy wbDest.Sheets(ws.Name).Cells(wbDest.Sheets(ws.Name).Rows.Count, "B").End(xlUp).Offset(1)
            End With
        Next ws
        OpenBook.Close False
    Else
        MsgBox ("You have not selected a file. Please try again.")
    End If
    Application.ScreenUpdating = True
End Sub