Question

我正在建立一个项目管理电子表格，其中多个团队将拥有一份副本。我想创建一个简单的地址簿。我在表格中有团队名称并使用VBA，我创建了Master Table。

在B4:D5范围内，有一个包含三个列名的简单表：

名称
电话
电子邮件

我已将此表（在名称管理器中）命名为ContactTeam1

我想将这个精确的3x2表格复制并粘贴到每个相应的团队下方，例如图片Here，并将每个命名表格更改为ContactTeam2，ContactTeam3，依此类推。< / p>

我想使用VBA的原因是因为我们有很多不同的项目，所以我想尽可能地自动化这个过程，以及未来的项目。

我将手工填写所有必要信息（姓名，电话，电子邮件）的表格。我想使用表的原因是它有自动扩展的优点，可以在最后一行之下包含任何新行。

作为奖励功能，当有人点击顶部包含团队名称的单元格时。（Team Blue，Team Red等）相应范围的所有电子邮件都将复制到剪贴板，以便在电子邮件客户端中使用。（这可以通过表格更容易完成 - 我还想使用它们的另一个原因。）

Answer 1

我希望这会有所帮助

Sub Bouton()

    Dim cell As Range
    Dim rng As Range
    Dim cnt As Integer
    Dim RangeName As String
    Dim CellAdd1, CellAdd2 As String

    For cnt = 2 To ActiveSheet.Range("NumberTimes")

        Set rng = Range("ContactTeam" & (cnt - 1))

        RangeName = "ContactTeam" & cnt
        CellAdd1 = Cells(rng.Row, rng.Column + 3).Address
        CellAdd2 = Cells(rng.Row + 1, rng.Column + 5).Address 
        '+ 1 in the row so the named range goes from B4 to D5 

        Set cell = ActiveSheet.Range(CellAdd1, CellAdd2)
        ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=cell

        Range("ContactTeam1").Copy Range("ContactTeam" & cnt)

    Next cnt

End Sub

我不是VBA中最好的，但它的作用是它每3个单元格创建一个新范围，并将其从ContactTeam2命名为任何限制。我创建了一个名为NumberTimes的命名范围。基本上，您可以告诉它要创建多少个新范围。

Answer 2

最简单的，我想我们可以在这里使用字典。会更快，但在这里他是我测试/尝试的，完全对你的数据和工作。

Sub d（）

Sheet1.Select

范围（＆＃34; B3＆＃34）。选择

待办事项

Range("b3:d4").Name = "mainteam"

 ActiveCell.Offset(0, 3).Select

Range("mainteam").Copy ActiveCell

 Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Select

Range(ActiveCell, ActiveCell.End(xlDown).End(xlToRight)).Name = "team" & i

i = i + 1

循环而我＆lt;＆gt; 5

End Sub

在同一工作表中多次复制（命名）表并更改表名称

2 个答案: