[英]adding a summary sheet in every workbook
嗨,我試圖循環瀏覽我文件夾中的所有工作簿,如果工作簿中沒有,則添加一個摘要表作為第一張工作表,問題是不是添加摘要工作表,而是重命名第一張工作表“概括”。 有什么我可以做的嗎? 提前致謝 !
下面是我的代碼,它是 select 我想要的文件夾並遍歷每個工作簿並檢查是否有“摘要”頁面,如果沒有,則復制工作簿的第一張並將其重命名為“摘要” ”。 但現在只是將第一張表重命名為“摘要”。
Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim ws As Worksheet
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'adds summary page
If wb1.Sheets(1).Name <> "Summary" Then
wb1.Sheets(1).Copy before:=Sheets(1)
ActiveSheet.Name = "Summary"
Else
End If
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
嘗試這個:
If wb1.Sheets(1).Name <> "Summary" Then
wb1.Sheets(1).Copy before:=wb.Sheets(1)
wb.Sheets(1).Name = "Summary"
End If
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.