0

以下代码浏览 excel 工作簿并允许您选择多个工作簿并将它们全部粘贴到一张表中，一切正常，但我的问题是当它粘贴它们时，它不会在它们之间留下空间来分隔文件。请任何人帮我。

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, 1)

wbk2.Close

Next i

End Sub
4

1 回答 1

1

如果我正确解释了您的问题（以及对评论的回复），要在从不同工作簿复制的数据之间放置空格，请在代码中更改此行：

ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row, 1)

对此：

ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1)

使用您的原始代码，您实际上是将一个工作簿中的最后一行数据替换为另一个工作簿的第一行。添加+2将在复制的最后一个数据集下方 2 行开始粘贴操作，这将在数据集之间为您提供 1 个空白行。显然，调整+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")

For i = 1 To UBound(fileStr)

    MsgBox fileStr(i), , GetFileName(CStr(fileStr(i)))

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

    If i = 1 Then ' if it's the first file, copy the headers

        wbk2.Sheets(1).UsedRange.Copy

    Else 'otherwise only copy the data (assumes headers are always in row 1

        wbk2.Sheets(1).Intersect(wbk2.Sheets(1).UsedRange, wbk2.Sheets(1).UsedRange.Offset(1)).Copy

    End If

    ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1).PasteSpecial xlPasteAll


    wbk2.Close

Next i

End Sub
于 2012-10-15T13:57:57.357 回答