0

次のコードを使用すると、複数のExcelファイルを同時に参照して、それらを1つのシートに貼り付けることができるため、ヘッダーを含むすべてをコピーすることが問題ですが、最初のファイルのみをコピーする必要がありますヘッダーと残りのヘッダーはすべて同じであるため、ヘッダーではなくデータのみをコピーし、互いの下に貼り付ける必要があります。

例:eg1 NAME,SURNAME,AGE
Kgotso,Smith,20

eg2名前、姓、年齢

ブライアン、ブラウン、32

結果： 名前、苗字、年齢

コッソ、スミス、20

ブライアン、ブラウン、32

Sub Button4_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")

    For i = 1 To UBound(fileStr)
    MsgBox fileStr(i), , GetFileName(CStr(fileStr(i)))
    Set wbk2 = Workbooks.Open(fileStr(i))
    wbk2.Sheets(1).UsedRange.Copy ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1)
    wbk2.Close
    Next i

End Sub
4

2 に答える 2

1

これは私の簡単な試みです：

Sub Button4_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
于 2012-10-16T07:55:06.913 に答える
1

これを試して

If i = 1 then
     ' Do your copy as is
Else
    ' Offset past firt row
    wbk2.Sheets(1).UsedRange.Offset(1, 0).Copy ...
    ' This will copy one blank line too
    ' Too avoid this extra line use instead
    Set rng2 = wbk2.Sheets(1).UsedRange.Offset(1, 0)
    Set rng2 = rng2.Resize(rng2.Rows.Count - 1)
    rng2.Copy ...
End If
于 2012-10-16T07:55:58.283 に答える