根据Excel中的列表自动创建工作表 [英] Automatically creating worksheets based on a list in excel

问题描述

我正在努力实现以下目标.

I am trying to achieve the following.

当我在范围A5:A50的主"工作表中输入值时，将运行一个宏，该宏将创建一个与该值同名的新工作表，然后将模板复制到新工作表上.

When I enter a value on 'Master' worksheet in the Range A5:A50, a macro is run which creates a new worksheet with the same name as the value and then copies the template onto the new sheet.

除此之外，我还想将主工作表"上输入的值旁边的值复制到此新工作表中，以便它自动进行计算.

In addition to this I would also like to copy the value adjacent to the value enter on Master worksheet to this new worksheet so it does calculations automatically.

例如，我在A5中输入"1"，在B5中输入"2".我想创建一个名为"1"的新工作表，从模板"工作表中复制模板，并将B5的值复制到名为"1"的新工作表上.

For example I enter '1' in A5 and '2' in B5. I would like to create a new worksheet with name '1', copy the template from 'Template' worksheet and copy the value of B5 on to the new worksheet named '1'.

我有以下代码，但是它也尝试复制运行有宏的Template工作表，这会导致错误，因为名称为'Template'的工作表已经存在.

I have following code but it also tries to copy Template worksheet with macro is run which results in an error because a worksheet with name 'Template' already exists.

Sub CreateAndNameWorksheets()
    Dim c As Range

    Application.ScreenUpdating = False
    For Each c In Sheets("Master").Range("A5:A50")
        Sheets("Template").Copy After:=Sheets(Sheets.Count)
        With c
            ActiveSheet.Name = .Value
            .Parent.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
                "'" & .Text & "'!A1", TextToDisplay:=.Text
        End With
    Next c
    Application.ScreenUpdating = True
 End Sub

推荐答案

右键单击主"工作表的名称"选项卡，然后选择"查看代码" .当VBE打开时，将以下内容粘贴到标题为 Book1-Master(Code) 的窗口中.

Right-click the Master worksheet's name tab and select View Code. When the VBE opens up, paste the following into the window titled something like Book1 - Master (Code).

Private Sub Worksheet_Change(ByVal target As Range)
    If Not Intersect(target, Rows("5:50"), Columns("A:B")) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.DisplayAlerts = False
        Application.Calculation = xlCalculationManual
        Dim r As Long, rw As Long, w As Long
        For r = 1 To Intersect(target, Rows("5:50"), Columns("A:B")).Rows.Count
            rw = Intersect(target, Rows("5:50"), Columns("A:B")).Rows(r).Row
            If Application.CountA(Cells(rw, 1).Resize(1, 2)) = 2 Then
                For w = 1 To Worksheets.Count
                    If LCase(Worksheets(w).Name) = LCase(Cells(rw, 1).Value2) Then Exit For
                Next w
                If w > Worksheets.Count Then
                    Worksheets("Template").Visible = True
                    Worksheets("Template").Copy after:=Sheets(Sheets.Count)
                    With Sheets(Sheets.Count)
                        .Name = Cells(rw, 1).Value2
                        .Cells(1, 1) = Cells(rw, 2).Value
                    End With
                End If
                With Cells(rw, 1)
                    .Parent.Hyperlinks.Add Anchor:=Cells(rw, 1), Address:="", _
                        SubAddress:="'" & .Value2 & "'!A1", TextToDisplay:=.Value2
                End With
            End If
        Next r
        Me.Activate
    End If
bm_Safe_Exit:
    Worksheets("Template").Visible = xlVeryHidden
    Me.Activate
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

请注意，这取决于您是否有一个名为 Template 的工作表才能生成新的工作表.它还保留了模板工作表xlVeryHidden，这意味着如果您尝试取消隐藏它，它将不会显示.进入VBE，然后使用属性"窗口(例如F4)将可见性设置为可见.

Note that this depends on you having a worksheet named Template in order to generate the new worksheets. It also keeps the Template worksheet xlVeryHidden which means that it will not show up if you try to unhide it. Go into the VBE and use the Properties window (e.g. F4) to set the visibility to visible.

此例程应该可以将多个值粘贴到A2:B50中，但是它将丢弃已经存在的A列中的建议工作表名称.在任何行的A列和B列中都必须有一个值，然后该值才能继续.

This routine should survive pasting multiple values into A2:B50 but it will discard proposed worksheet names in column A that already exists. There must be a value i both column A and column B of any row before it will proceed.

当前不检查非法的工作表名称字符.您可能需要熟悉这些内容并添加一些错误检查.

There are currently no checks for illegal worksheet name characters. You may want to familiarize yourself with those and add some error checking.

这篇关于根据Excel中的列表自动创建工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！