如何解决在列中循环插入工作表名称 - 不匹配错误
尝试执行以下操作
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
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。