我正在使用一个宏来遍历工作簿中所有工作表的步骤，如下所示。 但是，它出现了一个错误：
运行时错误“ 1004”： “工作表类的选择方法失败”
Sub WorksheetLoopFormat()
Dim WS_Count As Integer
Dim i As Integer
' Set WS_Count equal to the number of worksheets in the active
' workbook.
WS_Count = ActiveWorkbook.Worksheets.Count
' Begin the loop.
For i = 2 To WS_Count
Sheets(i).Select
Range("C:C,G:G,I:I,AN:AN").Select
Range("AN1").Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C30").Select
Sheets(i).Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
Next i
End Sub
希望有人会帮助我！！ 非常感谢！
答案 0 :(得分：0)
我认为以下所有内容都可以帮助您构建结构良好的代码：
Option Explicit
Sub LoopSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
With ws
Debug.Print .Name
End With
Next
End Sub
Sub AddSheet()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = "Test"
End Sub
Sub Copy_Paste()
Sheet1.Range("A1:D1").Copy Sheet2.Range("A1:D1")
End Sub
Sub DeleteSheet()
ThisWorkbook.Worksheets("Test").Delete
End Sub
答案 1 :(得分：0)
Sub WorksheetLoopFormatEasy()
Const cExc As String = "Sheet1" ' Worksheet Exception List
Const cSrc As String = "C:C,G:G,I:I,AN:AN" ' Source Range Address
Const cTgt As String = "A1" ' Target Cell Range Address
Dim wsS As Worksheet ' Source Worksheet
Dim wsT As Worksheet ' Target Worksheet
Dim vntE As Variant ' Exception Array
Dim i As Long ' Exception Array Element (Name) Counter
Dim strS As String ' Source Worksheet Name
' Copy Exception List to Exception Array.
vntE = Split(cExc, ",")
' In This Workbook (i.e. the workbook containing this code.)
With ThisWorkbook
' Loop through all Source Worksheets.
For Each wsS In .Worksheets
' Loop through elements (names) of Exception Array.
For i = 0 To UBound(vntE)
' Check if current name in exception array equals the current
' Worksheet name.
If Trim(vntE(i)) = wsS.Name Then Exit For ' Match found
Next
' Note: Exception Array is a zero-based one-dimensional array.
' If a match is NOT found, "i" will be equal to the number of
' names in Exception Array (i.e. UBound(vntE) + 1).
If i = UBound(vntE) + 1 Then
' Add a new worksheet (Target Worksheet) after Source Worksheet.
' Note: The newly added worksheet will become the ActiveSheet
' and will become the Target Worksheet.
.Sheets.Add After:=wsS
' Create a reference to Target Worksheet.
Set wsT = .ActiveSheet
' Copy Source Range to Target Range.
wsS.Range(cSrc).Copy Destination:=wsT.Range(cTgt)
' Write source worksheet name to Source Worksheet Name.
strS = wsS.Name
' Delete Source Worksheet.
' Note: Disabling DisplayAlerts suppresses showing
' of the 'delete message box'.
Application.DisplayAlerts = False
wsS.Delete
Application.DisplayAlerts = True
' Rename Target Worksheet to Source Worksheet Name.
wsT.Name = strS
End If
Next
End With
MsgBox "The program has finished successfully.", vbInformation, "Success"
End Sub
Sub WorksheetLoopFormatAdvanced()
Const cExc As String = "Sheet1" ' Worksheet Exception List
Const cSrc As String = "C:C,G:G,I:I,AN:AN" ' Source Range Address
Const cTgt As String = "A1" ' Target Cell Range Address
Dim wsS As Worksheet ' Source Worksheet
Dim wsT As Worksheet ' Target Worksheet
Dim vntE As Variant ' Exception Array
Dim i As Long ' Exception Array Element (Name) Counter
Dim lngA As Long ' Area Counter
Dim lngC As Long ' Source Range Columns Count(er)
Dim strS As String ' Source Worksheet Name
Dim strA As String ' ActiveSheet Name
' Speed up.
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
' Handle Errors.
On Error GoTo ErrorHandler
' Copy Exception List to Exception Array.
vntE = Split(cExc, ",")
' In This Workbook (i.e. the workbook containing this code.)
With ThisWorkbook
' Write the name of ActiveSheet to ActiveSheet Name.
strA = .ActiveSheet.Name
' Loop through all Source Worksheets.
For Each wsS In .Worksheets
'*******************************'
' Prevent Double Transformation '
'*******************************'
' Calculate Source Range Columns Count if not already calculated.
If lngC = 0 Then
' Loop through Areas of Source Range.
For lngA = 1 To wsS.Range(cSrc).Areas.Count
' Count the columns in current area.
lngC = lngC + wsS.Range(cSrc).Areas(lngA).Columns.Count
Next
' Check if number of used columns in Source Worksheet is equal
' to the number of columns of Source Range.
If wsS.Cells.Find("*", , xlFormulas, , xlByColumns, _
xlPrevious).Column - wsS.Range(cTgt).Column + 1 _
<= lngC Then GoTo DoubleTransformationError
End If
'*****************
' Transform Data '
'*****************
' Loop through elements (names) of Exception Array.
For i = 0 To UBound(vntE)
' Check if current name in exception array equals the current
' Worksheet name.
If Trim(vntE(i)) = wsS.Name Then Exit For ' Match found
Next
' Note: Exception Array is a zero-based one-dimensional array.
' If a match is NOT found, "i" will be equal to the number of
' names in Exception Array (i.e. UBound(vntE) + 1).
If i = UBound(vntE) + 1 Then
' Add a new worksheet (Target Worksheet) after Source Worksheet.
' Note: The newly added worksheet will become the ActiveSheet
' and will become the Target Worksheet.
.Sheets.Add After:=wsS
' Create a reference to Target Worksheet.
Set wsT = .ActiveSheet
' Copy Source Range to Target Range.
wsS.Range(cSrc).Copy Destination:=wsT.Range(cTgt)
' Write source worksheet name to Source Worksheet Name.
strS = wsS.Name
' Delete Source Worksheet.
' Note: Disabling DisplayAlerts suppresses showing
' of the 'delete message box'.
Application.DisplayAlerts = False
wsS.Delete
Application.DisplayAlerts = True
' Rename Target Worksheet to the name of Source Worksheet.
wsT.Name = strS
End If
Next
End With
MsgBox "The program has finished successfully.", vbInformation, "Success"
ProcedureExit:
' Activate worksheet that was active before program execution.
ThisWorkbook.Worksheets(strA).Activate
' Speed down.
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
DoubleTransformationError:
MsgBox "The program has already run.", vbInformation, _
"Double Transformation Prevention"
GoTo ProcedureExit
ErrorHandler:
MsgBox "An unexpected error has occurred. Error '" & Err.Number & "': " _
& Err.Description, vbInformation, "Error"
GoTo ProcedureExit
End Sub
新添加的工作表将具有与其前任相同的名称，但将具有不同的代号。