尝试创build打开新工作表的Excel VBAmacros，根据原始工作表中的相对单元格的值重命名它

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

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

我可以弄清楚如何打开工作表并进行复制和粘贴，但是在重新命名工作表时，我总是得到一个错误。

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 

在这里，下面是我希望新的名单=在macros中激活的第一个单元格的相对值，而不是“琼斯”。 这样我可以运行macros，并获得单独的表中的每个名称在A列。

 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

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

 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