使用完全相同的代码制作新工作表

Question

这是我下面的代码。我想复制它，以便它适用于每个新工作表，到目前为止，我必须进入并手动将代码更改为新工作表名称。这是很多工作，必须有一个我不知道的解决方法。我发现了循环，但如果该编码有效，我不会。它至少对我不起作用。我正在尝试为计费时间创建秒表功能。

我可以复制工作表并创建副本，但是在它说的新工作表中没有任何功能起作用

运行时错误 1004：范围类的选择方法失败

并停在这条线上：

Sheets("Client").Range("B" & iRow).Select 

任何帮助将不胜感激！！！

Sub Intialize()

    Dim iRow As Long
    
    iRow = Sheets("Client").Range("F" & Application.Rows.Count).End(xlUp).Row
    
    'Code to Validate
    
    If Sheets("Client").Range("D" & iRow).Value = "" Then
    
        Sheets("Client").Range("A" & iRow).Value = Format([Today()], "DD-MMM-YYYY")

        
    End If

End Sub

Sub Start_Time()

    Dim iRow As Long
    
    iRow = Sheets("Client").Range("F" & Application.Rows.Count).End(xlUp).Row + 1
    
    'Code to Validate
    
    If Sheets("Client").Range("B" & iRow).Value = "" Then
    
        MsgBox "Please select the Task Name from the drop down.", vbOKOnly + vbInformation, "Task Name Blank"
        Sheets("Client").Range("B" & iRow).Select
        Exit Sub
        
    ElseIf Sheets("Client").Range("D" & iRow).Value <> "" Then
    
        MsgBox "Start Time is aleady captured for the selected Task."
        Exit Sub
    Else
        
        Sheets("Client").Range("D" & iRow).Value = [Now()]
        
        Sheets("Client").Range("D" & iRow).NumberFormat = "hh:mm:ss AM/PM"
    
    End If

End Sub

Sub End_Time()

    Dim iRow As Long
    
    iRow = Sheets("Client").Range("F" & Application.Rows.Count).End(xlUp).Row + 1
    

    'Code to Validate
    
    If Sheets("Client").Range("D" & iRow).Value = "" Then
    
        MsgBox "Start Time has not been captured for this task."
        Exit Sub
    Else
        
        Sheets("Client").Range("E" & iRow).Value = [Now()]
        
        Sheets("Client").Range("E" & iRow).NumberFormat = "hh:mm:ss AM/PM"
        
        Sheets("Client").Range("F" & iRow).Value = Sheets("Client").Range("E" & iRow).Value - Sheets("Client").Range("D" & iRow).Value
        
        Sheets("Client").Range("F" & iRow).NumberFormat = "hh:mm:ss"
    
    End If

    Call Intialize

End Sub

Answer 1

好吧，既然你说： 1 需要复制一张Sheet 2 将代码应用于该工作表，无论名称如何 3 您将创建（复制）多个工作表。

这是我的代码。

（将所有内容粘贴到普通模块中）

Option Explicit
    
    Const A = 1
    Const B = 2
    Const D = 4
    Const E = 5
    Const F = 6
    Const L = 1048576 'Excel.Application.Rows.Count   

'With this you can check if you can copy the sheet
'and also, return that sheet you already checked,
'no matter the name of that sheet.

Private Function SetSheet(sht As Worksheet) As Worksheet

    'This function validate if the sheet is one that you need to copy
    'Assuming the first sheets of the book are used to:
    '
    'Parameters         1
    'Main               2
    'Other...           3
    
    If sht.Index >= 4 Then 'Here is where (Sheet #4 and so on) begins...
        Set SetSheet = sht
    Else
        'Message or do nothing...
        End
    End If
End Function

Sub Intialize()
'    You can uncomment this DIM vars but
'    need to comment the const above.

'    Dim F: F = Range("F1").Column
'    Dim D: D = Range("D1").Column
'    Dim A: A = Range("A1").Column
'    Dim L: L = Application.Rows.Count

    Dim ActSht As Worksheet: Set ActSht = SetSheet(ActiveSheet)
    Dim iRow As Long
    iRow = ActSht.Range(Cells(L, F), Cells(L, F)).End(xlUp).Row

'    Code to Validate

    If ActSht.Range(Cells(iRow, D), Cells(iRow, D)).Value = "" Then
        ActSht.Range(Cells(iRow, A), Cells(iRow, A)).Value = Format([Today()], "DD-MMM-YYYY")
    End If
End Sub

Sub Start_Time()
'    Dim B: B = Range("B1").Column
'    Dim F: F = Range("F1").Column
'    Dim D: D = Range("D1").Column
'    Dim L: L = Application.Rows.Count

    Dim ActSht As Worksheet: Set ActSht = SetSheet(ActiveSheet)
    Dim iRow As Long
    iRow = ActSht.Range(Cells(L, F), Cells(L, F)).End(xlUp).Row + 1
    
'    Code to Validate

    If ActSht.Range(Cells(iRow, B), Cells(iRow, B)).Value = "" Then
        MsgBox "Please select the Task Name from the drop down.", vbOKOnly + vbInformation, "Task Name Blank"
        ActSht.Range(Cells(iRow, B), Cells(iRow, B)).Select
        Exit Sub
    ElseIf ActSht.Range(Cells(iRow, D), Cells(iRow, D)).Value <> "" Then
        MsgBox "Start Time is aleady captured for the selected Task."
        Exit Sub
    Else
        ActSht.Range(Cells(iRow, D), Cells(iRow, D)).Value = [Now()]
        ActSht.Range(Cells(iRow, D), Cells(iRow, D)).NumberFormat = "hh:mm:ss AM/PM"
    End If
End Sub

Sub End_Time()
'    Dim D: D = Range("D1").Column
'    Dim F: F = Range("F1").Column
'    Dim E: E = Range("E1").Column
'    Dim L: L = Application.Rows.Count

    Dim ActSht As Worksheet: Set ActSht = SetSheet(ActiveSheet)
    Dim iRow As Long
    iRow = ActSht.Range(Cells(L, F), Cells(L, F)).End(xlUp).Row + 1

'    Code to Validate
    If ActSht.Range(Cells(iRow, D), Cells(iRow, D)).Value = "" Then
        MsgBox "Start Time has not been captured for this task."
        Exit Sub
    Else
        ActSht.Range(Cells(iRow, E), Cells(iRow, E)).Value = [Now()]
        ActSht.Range(Cells(iRow, E), Cells(iRow, E)).NumberFormat = "hh:mm:ss AM/PM"
        
        ActSht.Range(Cells(iRow, F), Cells(iRow, F)).Value = Sheets("Client").Range("E" & iRow).Value - Sheets("Client").Range("D" & iRow).Value
        ActSht.Range(Cells(iRow, F), Cells(iRow, F)).NumberFormat = "hh:mm:ss"
    End If
    Call Intialize
End Sub

假设： 1 您从原始工作表中调用一个或多个此子规则。

注意： 最好不要以这种方式使用硬编码Sheets("Client").Range("D" & iRow).Value，因为当您需要调试时......很痛！这就是我更喜欢ActSht.Range(Cells(iRow, D), Cells(iRow, D)).Value 的原因，您可以在所有代码之上控制单个变量。