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

Question

I have a master list of contacts. I'm trying to create a macro that uses a relative reference point to:

Open a specific sheet template Give it a name that = value of ActiveCell or first cell activated in macro and copy and pastes information from the master list to the new sheet open

I can figure out how to do open the sheet and do the copy and pasting but I always get an error when it comes to renaming the sheet.

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

Below here, is where I'd like the name of the new sheet = the relative value of the first cell activated in the macro instead of "Jones". This way I can run the macro and get seperate sheets for each name in 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

Answer 1

You should probably be doing this in a loop, over the range of cells containing patient names.

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