尝试创建打开新工作表的excel vba宏，根据原始工作表中相对单元格的值重命名该宏

我有一个联系人的主列表。我正在尝试创建一个宏，该宏使用相对参考点来：

打开特定的图纸模板 给它一个名称，该名称=ActiveCell的值或宏中激活的第一个单元格的值 并将信息从主列表复制粘贴到新打开的图纸

我可以想出如何打开工作表并进行复制和粘贴，但在重命名工作表时，我总是会出错

ActiveCell.Range("A1,A2:B26").Select
ActiveCell.Offset(1, 0).Range("A1").Activate
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
ActiveCell.Offset(-1, 0).Range("A1").Select
Sheets("Patient List").Select
Sheets.Add Type:= _
    "C:\Users\Valerie\AppData\Roaming\Microsoft\Templates\Patient-History-Template1.xltx"
Sheets("Patient List").Select
Selection.Copy
Sheets("Patient List").Select
Sheets("Patient List").Name = "Patient List"
Sheets("Patient 1").Select

下面是我希望新工作表的名称=宏中激活的第一个单元格的相对值，而不是“Jones”。这样，我就可以运行宏，并为columnA中的每个名称获得单独的工作表

Sheets("Patient 1").Name = "Jones"
Sheets("Jones").Select
ActiveSheet.Paste
Sheets("Patient List").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Jones").Select
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveSheet.Paste
Sheets("Patient List").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Jones").Select
ActiveCell.Offset(2, -1).Range("A1").Select
ActiveSheet.Paste
Sheets("Patient List").Select

---

您可能应该在包含患者姓名的单元格范围内循环执行此操作

Sub TestAddPatientSheet()
Dim rng As Range
Dim r As Long 'row iterator
Dim patientName As String
Dim patientSheet As Worksheet

Sheets("Patient List").Activate

Set rng = Set rng = Sheets("Patient List").Range("A2:B26")   '<-- this is the range of cells w/patient names in Col A
    For r = 1 To rng.Rows.Count
        patientName = rng(r, 1).Value
        'Creates a new worksheet
        Set patientSheet = Sheets.Add(After:=Sheets("Patient List"), _
            Type:="C:\Users\Valerie\AppData\Roaming\Microsoft\Templates\Patient-History-Template1.xltx")
ResRetry:
        'Attempt to rename the sheet, trapping errors (if any) and allowing re-try
        On Error GoTo ErrName:
        patientSheet.Name = patientName
    Next
Exit Sub

ErrName:
Err.Clear
MsgBox patientName & " is not a valid worksheet name", vbCritical

patientName = InputBox("Please rename the worksheet for " & patientName & "." & _
                        vbCRLF & "Make sure the sheet name doesn't already exist, is " & _
                        "fewer than 32 characters, and does not contain " & vbCRLF & _
                        "special characters like %, *, etc.", "Rename sheet for " & patientName, patientName)
Resume ResRetry


End Sub

子测试患者表（）
变暗rng As范围
Dim r作为长行迭代器
用字符串命名
将患者表设置为工作表
工作表（“患者名单”）。激活
设置rng=设置rng=床单（“患者名单”）。范围（“A2:B26”）'请给我们一个分析代码。。。可能存在一些问题-名称已经存在，您使用了不允许使用的字符，等等。@KazJaw这是宏的代码。