如何插入文件名

如下因素代码可以让我浏览多个不同的Excel文件，并将其粘贴在每个other.the低于单张excel文件具有相同的列名，但对他们有不同的数据和工作正常，我问题是我需要它时，它粘贴一个文件，它必须写它的每个文件的文件的名称它的粘贴。我的excel文件的名称被称为Familycar和其他excel的文件名称被称为smartcar如何插入文件名

例如

EG1 CarName，燃料，颜色

宝马，汽油，红

福特，柴油，绿色

马自达，汽油，灰色

EG2 CarName，燃料，颜色

奥斯汀，汽油，蓝

大众，柴油，白

奥迪，汽油，黑色

结果

CarName，燃料，颜色，文件名

宝马，汽油，红色，的FamilyCar

福特，柴油，绿色的FamilyCar

Mazda，Petrol，Grey，Familycar

奥斯汀，汽油，蓝色，smatrtcar

大众，柴油，白，智能车

奥迪，汽油，黑色，智能车

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

来源

2012-10-17 Cwala

这里是你的代码重构，包括这一要求

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

来源

2012-10-17 07:59:42

由于它的工作...但它不会离开文件名文件之间的空白空间... – Cwala

添加到您的代码

' 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

来源

2012-10-17 07:53:23 Larry

如何插入文件名

回答

相关问题