試圖創建打開新工作表的Excel VBA宏，根據原始工作表中的相對單元格的值重命名它

我有一個主要的聯繫人列表。我試圖創建一個使用相對參考點到宏：試圖創建打開新工作表的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

下面這裏，是我想新表的名稱=在宏代替「瓊斯」活化所述第一小區的相對值。通過這種方式，我可以運行宏併爲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

來源

2013-03-26 Al GoRhythm

請給我們分析代碼...可能會有一些problems-名稱已經存在，您使用的是不允許的字符，等等 – 2013-03-26 22:51:34

@KazJaw這裏是宏的代碼。 – 2013-03-26 23:24:04

您應該在包含患者姓名的單元格範圍內循環執行此操作。

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-27 00:07:51

試圖創建打開新工作表的Excel VBA宏，根據原始工作表中的相對單元格的值重命名它

回答

相關問題