尝试执行以下操作
1- 打开包含多个工作簿(Origins)的目录,复制/粘贴 每个工作表进入主工作簿(Destin)
2- 在主工作表 (Destin) 的“A”列中插入来自 dir (Origin) 的每个工作表的名称 - 工作表名称包含日期
3- 最后,通过复制/粘贴每个工作表将主工作簿(Destin)中的所有工作表合并到“摘要”表中 另一个下面的工作表(即数据库格式)
让第 1 步工作......现在卡住了(第 2 步不匹配错误)
Option Explicit
Sub AllFiles()
'Application.EnableCancelKey = xlDisabled
Application.DisplayAlerts = True
Application.ScreenUpdating = False
Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
Dim Masterwb As Workbook
Dim sh As Worksheet
Dim NewSht As Worksheet
Dim FindRng As Range
Dim PasteRow As Long
Dim lastrow As Long
' set master workbook
Set Masterwb = Workbooks("masterbook_AAFC.xlsm")
folderPath = "C:\Users\axchilmeran.G3NETWORK\Downloads\Master_AAFC\" 'contains folder path
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
Filename = Dir(folderPath & "*.csv*")
Do While Filename <> ""
Set wb = Workbooks.Open(folderPath & Filename)
If Len(wb.Name) > 35 Then
MsgBox "Sheet's name can be up to 31 characters long, shorten the Excel file name"
wb.Close False
GoTo Exit_Loop
Else
' add a new sheet with the file's name (remove the extension)
Set NewSht = Masterwb.Worksheets.Add(After:=Masterwb.Worksheets(1))
NewSht.Name = Replace(wb.Name, ".pdf.csv", "")
End If
' loop through all sheets in opened wb
For Each sh In wb.Worksheets
' get the first empty row in the new sheet
Set FindRng = NewSht.Cells.Find(What:="*", Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
If Not FindRng Is Nothing Then ' If find is successful
PasteRow = FindRng.Row + 1
Else ' find was unsuccessfull > new empty sheet, should paste at the first row
PasteRow = 1
End If
sh.UsedRange.Copy
NewSht.Range("B" & PasteRow).PasteSpecial xlPasteValues
<块引用>
下面这两行给了我不匹配错误!
**lastrow = NewSht.UsedRange.Rows(NewSht.UsedRange.Rows.Count).Row
Worksheets(NewSht).Range("A2:A" & lastrow).Value = NewSht.Name**
Next sh
wb.Application.CutCopyMode = False
wb.Close False
Exit_Loop:
Set wb = Nothing
Filename = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub