0

次のコードを使用すると、複数の異なるExcelファイルを参照して、それらを1つのシートの下に貼り付けることができます.Excelファイルには同じ列名がありますが、異なるデータが含まれており、正常に動作しています.私の問題は、ファイルを貼り付けるには、追加の列を作成し、貼り付けるファイルごとにその列にそのファイルの名前を書き込む必要があります。

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))
 'using offset to skip the header - not the best solution,  but a quick one

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

 wbk2.Close
 Next i
 End Sub
4

1 に答える 1

1

Insertオブジェクトのメソッドを使用してRange、列を挿入します。

'***** Inserts new column to the left of column C
Range("C:C").Insert

セルにテキストを入力する:

'***** Entering text in A1
ws1.Cells(1, 1).Value = fileStr(i)
于 2012-10-16T12:42:00.843 に答える