时间戳

首页 > 解决方案 > 在 VBA 中引用多个“模板”工作表

vba - 在 VBA 中引用多个“模板”工作表

问题描述

我目前有一个 VBA 代码（如下），它贯穿我的第一张工作表（发票）并根据发票编号创建单独的工作表。目前它使用来自工作表“模板”的模板。

我希望能够：

首先 - 根据我的发票表中的单元格值（可能是标题为“雇用”的列，其中值是任一y 或 n)。

其次 - 与其一次性运行它，不如让它仅在发票表中填写新行时创建一个新表（也许这是在下一个空白行中为发票编号列赋予值时）。

我确信您可以告诉我，我当前的代码是从许多来源编译而来的，主要来自 Google 搜索，然后进行了调整以满足我的需要。因此，它可能不是最优雅或最简洁的做事方式。对于如何改进我的代码以更好地满足我的需求的任何指导，我将不胜感激！

它所做的另一件事是创建一些超链接单元格，以便在工作簿周围导航（最多可以有 100 多张），但我对它们在此示例中的工作方式感到满意。

此外，调整列和行大小对于让事情变得整洁有点困难。是否有一种更简洁的方法可以相应地从模板（或雇用模板）表中引用它？

如果有什么我可以更清楚的或者我可以提供的任何进一步的信息来帮助你帮助我，请告诉我！

在此先感谢您的帮助！

里斯

Sub AddNamedSheets()
Dim srcName, dstName As Range
Dim invoicesSheet As Worksheet
Dim templateSheet As Worksheet
Dim NewSheet As Worksheet
Dim myBook As Workbook
Dim lastRow As Long
Dim i As Long
Dim namesColumn


'Define your workbook - here set as the active workbook
Set myBook = ActiveWorkbook

'Define your worksheets - The sheets are named "Invoices" and "Template" respectively
Set invoicesSheet = myBook.Worksheets("Invoices")
Set templateSheet = myBook.Worksheets("Template")

'Define which column in your master tab the list is - here it's B i.e. column 2
namesColumn = 2

'Find the last row of the sheets list
lastRow = invoicesSheet.Cells(invoicesSheet.Rows.Count, namesColumn).End(xlUp).Row


'Cycle through the list - Assuming the list starts in column "A" from the 2nd row
For i = 2 To lastRow

'Create Worksheets and Copy Row
  Set srcName = Sheets("Invoices").Range("A" & i)
     ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
     ActiveSheet.Name = srcName
       srcName.Range("A" & 1).Copy Destination:=ActiveSheet.Range("J3")
'Create Hyperlink to new sheet
         srcName.Hyperlinks.Add Anchor:=srcName, _
             Address:="", SubAddress:=srcName & "!J3", _
             TextToDisplay:=srcName.Value
'Create HyperLink back to Main sheet
  Set dstName = ActiveSheet.Range("J3")
         dstName.Hyperlinks.Add Anchor:=dstName, _
             Address:="", SubAddress:="'Invoices'!A1", _
             TextToDisplay:=dstName.Value
'Copy data from template
Worksheets("Template").Range("A1:J46").Copy _
    Destination:=ActiveSheet.Range("A1")

Rows("1").RowHeight = 110
Rows("2").RowHeight = 30
Rows("3:6").RowHeight = 21
Rows("7:34").RowHeight = 20
Rows("35:44").RowHeight = 21
Rows("45:46").RowHeight = 16

Columns("A").ColumnWidth = 10
Columns("B").ColumnWidth = 15
Columns("C").ColumnWidth = 17.5
Columns("D").ColumnWidth = 20
Columns("E").ColumnWidth = 10
Columns("F").ColumnWidth = 10
Columns("G").ColumnWidth = 10
Columns("H").ColumnWidth = 15



  Next
End Sub

标签： vbaexcel

解决方案

未经测试，但类似于：

Sub AddNamedSheets()

    Dim srcName, dstName As Range
    Dim invoicesSheet As Worksheet
    Dim templateSheet
    Dim NewSheet As Worksheet
    Dim myBook As Workbook
    Dim lastRow As Long
    Dim i As Long
    Dim namesColumn

    Set myBook = ActiveWorkbook

    Set invoicesSheet = myBook.Worksheets("Invoices")

    'Define which column in your master tab the list is - here it's B i.e. column 2
    namesColumn = 2

    'Find the last row of the sheets list
    lastRow = invoicesSheet.Cells(invoicesSheet.Rows.Count, namesColumn).End(xlUp).Row

    'Cycle through the list - Assuming the list starts in column "A" from the 2nd row
    For i = 2 To lastRow

        'which template to copy? keys off ColJ here for example
        If LCase(invoicesSheet.Cells(i, 10).Value) = "y" Then
            Set templateSheet = myBook.Worksheets("Hire Template")
        Else
            Set templateSheet = myBook.Worksheets("Template")
        End If

        'copy the template and rename it
        templateSheet.Copy after:=myBook.Worksheets(myBook.Worksheets.Count)
        Set NewSheet = myBook.Worksheets(myBook.Worksheets.Count)
        NewSheet.Name = srcName.Value

        Set srcName = invoicesSheet.Range("A" & i)
        srcName.Copy Destination:=NewSheet.Range("J3")
        Set dstName = NewSheet.Range("J3")

        'Create Hyperlink to new sheet
        srcName.Hyperlinks.Add Anchor:=srcName, _
            Address:="", SubAddress:=srcName & "!J3", _
            TextToDisplay:=srcName.Value

        'Create HyperLink back to Main sheet
        dstName.Hyperlinks.Add Anchor:=dstName, _
            Address:="", SubAddress:="'Invoices'!A1", _
            TextToDisplay:=dstName.Value

    Next i

End Sub

推荐阅读