VBA拉數據關閉的文件

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行，直到你全部正常工作。

注：我找到.copy這裏的MS Docs和.paste這裏的MS Docs的參考文獻。