Question

以下代码浏览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

Answer 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

如何插入空格

1 个答案: