CODEWITHSUNDEEP
vbaexcel
Cwala
Cwala

Reputation: 29

How to Insert filename

the folowing code allows me to browse for multiple different excel files and paste them in a single sheet below each other.the excel file have the same column names but have different data in them and is working fine, my problem is i need it when it paste a file it must write the name of that file for each and every file it paste.The name of my excel file is called Familycar and the file name of other excel is called smartcar

example

eg1 CarName,Fuel,Colour

BMW,Petrol,Red

Ford,Diesel,Green

Mazda,Petrol,Grey

eg2 CarName,Fuel,Colour

Austin,Petrol,Blue

VW,Diesel,White

Audi,Petrol,Black

Result

CarName,Fuel,Colour,FileName

BMW,Petrol,Red,Familycar

Ford,Diesel,Green,Familycar

Mazda,Petrol,Grey,Familycar

Austin,Petrol,Blue,smatrtcar

VW,Diesel,White,smartcar

Audi,Petrol,Black,smartcar

   Sub Button5_Click()
 Dim fileStr As Variant
 Dim wbk1 As Workbook, wbk2 As Workbook
 Dim ws1 As Worksheet

 fileStr = Application.GetOpenFilename(FileFilter:="microsoft excel files (*.xlsx), *.xlsx", Title:="Get File", MultiSelect:=True)
 Set wbk1 = ActiveWorkbook
 Set ws1 = wbk1.Sheets("Sheet3")

 'handling first file seperately
 MsgBox fileStr(1), , GetFileName(CStr(fileStr(1)))
 Set wbk2 = Workbooks.Open(fileStr(1))
 wbk2.Sheets(1).UsedRange.Copy ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1)

 wbk2.Close

 For i = 2 To UBound(fileStr)
 MsgBox fileStr(i), , GetFileName(CStr(fileStr(i)))

 Set wbk2 = Workbooks.Open(fileStr(i))

 wbk2.Sheets(1).UsedRange.Offset(1, 0).Copy ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1)


 wbk2.Close
 Next i

Upvotes: 0

Views: 3439

Answers (2)

chris neilsen
chris neilsen

Reputation: 53146

Here's your code refactored to include this requirement

Sub Button5_Click()
    Dim fileStr As Variant
    Dim wbk1 As Workbook, wbk2 As Workbook
    Dim ws1 As Worksheet
    Dim rngSource As Range
    Dim rngDest As Range
    Dim rwOffset As Long
    Dim sFileName As String

    Dim i As Long

    fileStr = Application.GetOpenFilename(FileFilter:="microsoft excel files (*.xlsx), *.xlsx", Title:="Get File", MultiSelect:=True)
    Set wbk1 = ActiveWorkbook
    Set ws1 = wbk1.Sheets("Sheet3")

    For i = 1 To UBound(fileStr)
        MsgBox fileStr(i), , GetFileName(CStr(fileStr(i)))

        ' Used to change copy range for first file, without repeating code
        rwOffset = IIf(i = 1, 0, 1)
        Set wbk2 = Workbooks.Open(fileStr(i))

        ' File Name without extension
        sFileName = Left$(wbk2.Name, InStrRev(fileStr(i), ".") - 1)  

        Set rngSource = wbk2.Sheets(1).UsedRange.Offset(rwOffset, 0)
        Set rngDest = ws1.Cells(ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 2, 1)

        rngSource.Copy rngDest

        ' Add filename next to pasted data
        rngDest.Offset(0, rngSource.Columns.Count).Resize(rngSource.Rows.Count, 1) = sFileName
        wbk2.Close
    Next i

End Sub

Upvotes: 3

Larry
Larry

Reputation: 2794

adding to your code

' ws1 is the result/output worksheet
' wbk2 is the input workbook I assume
Dim fromRow As Long
Dim toRow As Long
Dim colNum As Long 'please defind the column Number to output the workbook's name
' In your example, it would be 4
colNum = 4
fromRow = ws1.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
wbk2.Sheets(1).UsedRange.Offset(1, 0).Copy ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1)
toRow = ws1.Cells(ws.Rows.Count, 1).End(xlUp).Row
ws1.Range(ws1.Cells(fromRow, colNum), ws1.Cells(toRow, colNum)).Value = wbk2.Name

Upvotes: 1

Related Questions