尝试创建打开新工作表的 excel vba 宏，根据原始工作表中相关单元格的值对其进行重命名
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/15648836/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Trying to create excel vba macro that opens new sheet, renames it according to value of relative cell in original sheet
提问by Al GoRhythm
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
打开一个特定的工作表模板 给它一个名称 = ActiveCell 的值或在宏中激活的第一个单元格，然后将信息从主列表复制并粘贴到打开的新工作表
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.
下面是我想要的新工作表的名称 = 宏中激活的第一个单元格的相对值，而不是“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
回答by David Zemens
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
