Question

Private Sub CommandButton1_Click()

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = "c:\Vouchers\"
fileName = Dir(directory & "*.csv??")

Do While fileName <> ""

Workbooks.Open (directory & fileName)

For Each sheet In Workbooks(fileName).Worksheets
total = Workbooks("Voucher Report 26MAR V1.0.xlsm").Worksheets.Count
Workbooks(fileName).Worksheets(sheet.Name).Copy _
after:=Workbooks("Voucher Report 26MAR V1.0.xlsm").Worksheets(total)
Next sheet

Workbooks(fileName).Close

fileName = Dir()

Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

上面的代码获取了我需要的所有数据，但是为每个工作簿创建了一个新工作表，无论如何将数据放在第10行的第一个工作簿中，然后在下一个可用行中添加下一个工作簿中的数据？

Answer 1

试一试。请注意，您可能需要调整Dest工作表的值，我已根据您的代码尽可能地定义了它。

Private Sub CommandButton1_Click()

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Dim Dest as Worksheet
Dim DestRow as long
Dim Source as Workbook

'adjust this as necessary - it should create a new sheet at the end of 
'"Voucher Report...", and call it "My New Sheet"
Set Dest = Workbooks("Voucher Report 26MAR V1.0.xlsm").Worksheets.add _
           after:=Workbooks("Voucher Report 26MAR V1.0.xlsm").Worksheets.Count _
           Name:="My New Sheet"
DestRow = 10
Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = "c:\Vouchers\"
fileName = Dir(directory & "*.csv??")

Do While fileName <> ""
  'assign the opened workbook to a var for easier use
  set source = Workbooks.Open (directory & fileName)
  For Each sheet In source.Worksheets
    'copy the UsedRange cells from the sheet
    '.copy is kind of weird, but this works
    sheet.cells(1,1).resize(sheet.usedrange.rows.count, sheet.usedrange.columns.count).copy
    'paste doesn't apply to a range, but to a worksheet object
    '   the destination param tells it where to go
    dest.paste destination:=range(cells(destrow,"A")
    'increment the current row pointer but the number of rows used
    destrow = destrow + sheet.usedrange.rows.count
  Next sheet
  Workbooks(fileName).Close
  fileName = Dir()
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

所有代码未经测试，因此您可能会进行一些小调整。我建议您注释ScreenUpdating行，直到您完全正常工作。

注意：我在MS Docs中找到了.copy的引用，MS Docs中找到了.paste的引用。

VBA从多个已关闭的文件中提取数据

1 个答案: