您好我嘗試將多個報表合并為一個但沒有成功，首先我設定代碼讓用戶輸入包含多個報表的檔案夾所在的路徑，然后將代碼全部打開并復制并粘貼到一個新的，但沒有成功.. VBA 無法識別第二部分并打開檔案。
Sub files()
Dim folderpath As String
Dim FileOpen As String
Dim DialogBox As FileDialog
Dim wbk As Workbook
Dim wbk1 As Workbook
Set wbk1 = ThisWorkbook
Dim Filename As String
folderpath = InputBox("Please introduce the path where files are stored", "Select Files' Path", "Paste path here")
FileOpen = Dir(folderpath & "\*.xls*")
Do While Len(Filename) > 0
Set wbk = Workbooks.Open(FileOpen)
wbk.Activate
Range(“A1”).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows(“Book1”).Activate
Application.DisplayAlerts = False
Dim lr As Double
lr = wbk1.Sheets(“Sheet1”).Cells(Rows.Count, 1).End(xlUp).Row
Sheets(“Sheet1”).Select
Cells(lr 1, 1).Select
ActiveSheet.Paste
wbk.Close True
Filename = Dir
Loop
End Sub*
uj5u.com熱心網友回復：
將作業表的范圍復制到新作業簿
Option Explicit
Sub CreateReport()
Dim sFolderPath As String
sFolderPath = InputBox("Please introduce the path where files are stored", _
"Select Files' Path", "Paste path here")
If Len(sFolderPath) = 0 Then Exit Sub
If Right(sFolderPath, 1) <> "\" Then sFolderPath = sFolderPath & "\"
Dim sFilename As String: sFilename = Dir(sFolderPath & "*.xls*")
If Len(sFilename) = 0 Then Exit Sub
Dim dwb As Workbook: Set dwb = Workbooks.Add(xlWBATWorksheet)
Dim dws As Worksheet: Set dws = dwb.Worksheets(1)
Dim dfCell As Range
Set dfCell = dws.Range("A1")
Dim swb As Workbook
Dim sws As Worksheet
Dim srg As Range
Dim sFilePath As String
Dim sCount As Long
Do While Len(sFilename) > 0
Set swb = Workbooks.Open(sFolderPath & sFilename)
On Error Resume Next ' test if the worksheet exists
Set sws = swb.Worksheets("Sheet1")
On Error GoTo 0
If Not sws Is Nothing Then ' worksheet exists
sCount = sCount 1
If sCount = 1 Then ' with headers
Set srg = sws.Range("A1").CurrentRegion
Else ' without headers
With sws.Range("A1").CurrentRegion
Set srg = .Resize(.Rows.Count - 1).Offset(1)
End With
End If
srg.Copy dfCell
Set dfCell = dfCell.Offset(srg.Rows.Count)
Set sws = Nothing
'Else ' worksheet doesn't exist
End If
swb.Close SaveChanges:=False
sFilename = Dir
Loop
MsgBox "Report created out of " & sCount & " worksheets.", _
vbInformation, "CreateReport"
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/405369.html
標籤：
上一篇：如何限制訪問中的小數位
下一篇：在VBA中清除內容后粘貼問題