0

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

打开特定工作表模板为其命名 = 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

在下面，我想要新工作表的名称 = 在宏中激活的第一个单元格的相对值，而不是“琼斯”。这样我就可以运行宏并为 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
4

1 回答 1

2

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

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
于 2013-03-27T00:07:51.903 回答