使用以下代码我可以同时浏览多个excel文件并将它们粘贴在彼此相同的单张纸上,所以我的问题是它复制包括标题在内的所有内容,但事情是我只想让它复制带有标题的第一个文件,其余的必须只复制不是听众的数据并将其粘贴在彼此之下,因为它们的标题都是相同的。
示例:eg1 NAME,SURNAME,AGE
Kgotso,Smith,20
eg2 NAME,SURNAME,AGE
布赖恩,棕色,32
结果: NAME,SURNAME,AGE
Kgotso,史密斯,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
答案 0 :(得分:2)
这是我对此的快速尝试:
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
答案 1 :(得分:2)
试试这个
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