您好我正在嘗試選擇具有可變問題級別的命名作業表，該變數來自每張作業表中的一個單元格。
目前我有 5 張表（可以是任何數字），它們都具有相同的名稱和問題級別，但表編號為 1 到 5。代碼應查找具有表名稱和當前問題級別的表，該表取自單元格每張紙，然后復制并用下一個問題編號重命名。復印表的新名稱和頁碼以及發行級別都來自每張表中的另一個單元格。
我撰寫了以下代碼并嘗試了許多不同程度的成功變體，但目前它什么也沒做！我認為我定義要查找的作業表名稱的方式失敗了？
Sub UpIssueAllGRnR()
'Start loop to find named sheets
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
'Define name for sheets to be duplicated (name start and current issue number)
If Left(ws.Name, 20) = "Gauge RnR Att Iss " & Cells(4, 16) Then
'Copy active sheet
ActiveSheet.Copy After:=Sheets(ActiveSheet.Index)
'Rename new sheet from defined cell (Same name and sheet number but with new issue level)
Dim NewNamex As String
NewNamex = ActiveSheet.Range("P14").Value
ActiveSheet.Name = NewNamex
End If
'Go to next defined sheet name
Next ws
End Sub
任何幫助將不勝感激
uj5u.com熱心網友回復：
請注意：您正在混合對單元格和作業表的隱式和顯式參考。
我更新了代碼 - 但沒有測驗：
Sub UpIssueAllGRnR()
'Start loop to find named sheets
Dim ws As Worksheet
Dim NewNamex As String
For Each ws In ThisWorkbook.Worksheets
'-->> ws won't get activated!!!
'Define name for sheets to be duplicated (name start and current issue number)
'-->> use ws wherever you reference cells from that sheet
If Left(ws.Name, 20) = "Gauge RnR Att Iss " & ws.Cells(4, 16) Then
'Copy sheet = ws
ws.Copy After:=Thisworkbook.WorkSheets(ws.Index)
'Rename new sheet from defined cell (Same name and sheet number but with new issue level)
NewNamex = ws.Range("P14").Value
ws.Name = NewNamex
End If
'Go to next defined sheet name
Next ws
End Sub
uj5u.com熱心網友回復：
下面的代碼經過測驗，似乎在我設定的環境中作業。
Sub UpIssueAllGRnR()
Dim ws As Worksheet
Dim currIndex As Integer
For Each ws In ThisWorkbook.Worksheets
'Define name for sheets to be duplicated (name start and current issue number)
If Left(ws.Name, 20) = "Gauge RnR Att Iss " & Format(ws.Cells(4, 16).Value, "00") Then
currIndex = ws.Index
'Copy active sheet
ws.Copy After:=ThisWorkbook.Sheets(currIndex)
'Rename new sheet from defined cell (Same name and sheet number but with new issue level)
Dim NewNamex As String
NewNamex = ActiveSheet.Range("P14").Value
ThisWorkbook.Sheets(currIndex 1).Name = NewNamex
End If
Next ws
End Sub
uj5u.com熱心網友回復：
我沒有測驗過這段代碼，但是我修復了你犯的幾個錯誤。嘗試使用盡可能多的顯式代碼。我還建議您使用.Text而不是.Value確保得到一個字串。
Sub UpIssueAllGRnR()
'Start loop to find named sheets
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
'Define name for sheets to be duplicated (name start and current issue number)
If Left(ws.Name, 20) = "Gauge RnR Att Iss " & ws.Cells(4, 16).Text Then
'Copy active sheet
ws.Copy After:=Sheets(ws.Index)
'Rename new sheet from defined cell (Same name and sheet number but with new issue level)
ActiveSheet.Name = ActiveSheet.Name & ActiveSheet.Range("P14").Text
End If
'Go to next defined sheet name
Next ws
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/439840.html
上一篇：如何檢查檔案是否損壞？