Excel VBA – 复制模板工作表和链接单元格和命名表单

工作表中的“摘要”列中有A列中的数据。 有些月份有50行，有些则是500行。

我有一个名为“模板”的模板。 我想创build一个“模板”工作表的副本，将其命名为摘要（如此循环）的每一行之后，然后将行单元格数据放在工作表的单元格A1中。 最后回到汇总表中，我想在我的行中创build一个指向表单的超链接。

这是我想要的样子的图像：

Answer 1

在Excel中玩了一番之后，我相信这将适合您的需求。 只需放置到一个新的模块并执行。

Sub CreateLinkedSheets() Dim rngCreateSheets As Range Dim oCell As Range Dim oTemplate As Worksheet Dim oSummary As Worksheet Dim oDest As Worksheet Set oTemplate = Worksheets("Template") Set oSummary = Worksheets("Summary") Set rngCreateSheets = Worksheets("Summary").Range("A1", Range("A1").End(xlDown)) 'Above line assumes NO blank cells in your list of school supplies For Each oCell In rngCreateSheets.Cells oTemplate.Copy After:=Worksheets(Sheets.Count) Set oDest = ActiveSheet oDest.Name = oCell.Value oDest.Range("A1").Value = oCell.Value oSummary.Hyperlinks.Add Anchor:=oCell, Address:="", SubAddress:= _ oDest.Name & "!A1", TextToDisplay:=oDest.Name Next oCell End Sub 

我坚持使用macroslogging器的原始评论，首先检查代码输出，然后根据您的需要进行调整。 例如，我就是这样做的，以获得添加超链接的代码。

为了使这个代码工作，你的工作表必须被命名为“摘要”和“模板”（如图所示）， 列A中的列表必须是连续的 ，也就是说不能在列表中留下任何空白单元格。 如果您执行Set rngCreateSheets = Worksheets("Summary").Range("A1", Range("A1").End(xlDown))将不会正确设置范围，您将缺less项目。

Answer 2

search会给你很多答案，尤其是在Stackoverflow上。 下面是我search的一些例子，也许它会帮助你。

• search： 工作表复制VBA – 如何复制和重命名表
• search： 通过范围循环 – 显示这一点
• search： msgbox yes no vba – 如何创buildvba中的是/否框
• search： 检查工作表是否存在 – 它具有我在下面使用的相同的function
• search： vba超链接到工作表 – 如何创buildExcel中的超链接w / vba

我知道一个答案已经发布，但由于我已经有了一些东西，而且略有不同，所以我认为我会发布它，因为它有一些额外的function，你可以从中收集。 这包括：

1. 错误检查（如果存在相同名称的工作表）
2. 子例程作为一个独立的例程中调用，同时传递variables

试试看，让我知道你的想法。

  Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean 'Created by Tim Williams from Stackoverflow.com 'https://stackoverflow.com/questions/6688131/excel-vba-how-to-test-if-sheet-exists Dim sht As Worksheet If wb Is Nothing Then Set wb = ThisWorkbook On Error Resume Next Set sht = wb.Sheets(shtName) On Error GoTo 0 SheetExists = Not sht Is Nothing End Function Sub CreateSummarySheets(SummaryWS As Worksheet, TemplateWS As Worksheet) Dim newWS As Worksheet Dim rCell As Range Dim lastRow As Long Dim answer As Long lastRow = SummaryWS.Cells(Rows.Count, "A").End(xlUp).Row For Each rCell In SummaryWS.Range("$A$1:$A$" & lastRow) 'Add copy of template TemplateWS.Copy After:=Sheets(Sheets.Count) Set newWS = Sheets(Sheets.Count) 'Sheet exists error checking answer = 1 If SheetExists(newWS.Name) = False Then answer = vbNo answer = MsgBox("Sheet with the name " & rCell.Value & " already exists. Delete it?", vbYesNo, rCell.Value & " Sheet Exists") End If If answer = vbYes Then Sheets(rCell.Value).Delete End If If answer = 1 Or answer = vbYes Then newWS.Name = rCell.Value End If 'Populate newWS's cell A1 newWS.Cells(1, "A") = rCell.Value 'Add Hyperlink from summary to newWS newWS.Hyperlinks.Add Anchor:=rCell, Address:="", _ SubAddress:="'" & newWS.Name & "'" & "!A1", TextToDisplay:=newWS.Name Next rCell End Sub Sub test() Dim s_ws As Worksheet Set s_ws = Sheets("Summary") 'Two ways to run this function Call CreateSummarySheets(s_ws, Sheets("Template")) End Sub