创建从列表中输入新数据的原始工作簿的副本

时间:2015-12-21 20:51:55

标签: excel vba

尝试复制原始工作表,但列表/数组中的项目数量不同。

我的原始工作表的格式是它引用数据数组工作表中的单元格。

例如

TEST TIME Output1 Output2

   A        3         5           9  
   .        .         .           .
   .        .         .           .
   .        .         .           .
   Z        2         9           4

上面的内容类似于我的数据数组工作表,我会将单元格引用到格式化的工作表中。最终结果将是26个工作表,名为A test,B test,...和Z test。

有没有办法复制工作表,一遍又一遍地创建新的参考单元格?

我有什么:

Sub AddSheets()
Dim cell As Excel.Range
Dim SCHPipe As Excel.Worksheet
Dim MacroTBF1 As Excel.Workbook

Set SCHPipe = ActiveSheet
Set MacroTBF1 = ActiveWorkbook
For Each cell In SCHPipe.Range("B12:B15")
    With MacroTBF1
   .Sheets("OriginalTBF").Copy after:=.Sheets(.Sheets.Count)
   End If

Next cell
End Sub

我不知道如何将数据引用到每个正在创建的工作表中。这会不断收到错误消息。

1 个答案:

答案 0 :(得分:1)

像这样的东西,您需要调整数据和模板的布局:

Sub AddSheets()
    Dim cell As Range
    Dim SCHPipe As Worksheet, shtOrig As Worksheet
    Dim MacroTBF1 As Workbook, shtNew As Worksheet


    Set SCHPipe = ActiveSheet
    Set MacroTBF1 = ActiveWorkbook
    Set shtOrig = MacroTBF1.Sheets("OriginalTBF")


    For Each cell In SCHPipe.Range("B12:B15")

        If cell.Value <> "" Then

            shtOrig.Copy after:=MacroTBF1.Sheets(MacroTBF1.Sheets.Count)
            Set shtNew = MacroTBF1.Sheets(MacroTBF1.Sheets.Count)

            With shtNew
                .Name = cell.Value & " Test"
                .Range("A1").Value = cell.Value
                .Range("A2").Value = cell.Offset(0, 1).Value
                .Range("D49").Value = IIf(cell.Offset(0, 1).Value = "-", _
                                          cell.Offset(0, 5).Value, "")
            End With
        End If

    Next cell
End Sub