如何使用“执行循环”创建新的工作表,以及如何在不同的工作簿之间复制/粘贴?

时间:2019-03-29 12:24:29

标签: excel vba loops

我需要在Workbook1中创建一个新的工作表,并根据单元格值对其进行命名。 然后,我需要将值从Workbook1复制并粘贴到Workbook2中以运行模型。 然后,我需要将Workbook2的输出复制并粘贴到刚在Workbook1中创建的新工作表中。 然后,我需要重复执行此任务,直到遍历Workbook1列表中的所有条目为止。

在此过程中,我一直遇到多个问题。

我遇到的主要问题是宏在选择要复制和粘贴的值时遇到了麻烦。我不断收到运行时错误9,但无法解决。

我创建了一个Do Loop来尝试完成上面列出的所有步骤。

我还在Do Loop中创建了Do Loop以产生新的工作表。这将创建选项卡,但是在尝试纠正错误之后,已将工作表放置在两个不同的工作簿中。

我也不知道如何引用我在后续代码中创建的新标签,因此编写了一个名为“ NEW TAB”的占位符来表示这一点

每次运行模型时,由Workbook2创建的输出范围是不同的,所以我试图每次在工作簿之间复制和粘贴500,000行数据。产生1004错误,说行太多。

' Variable Declaration

Dim Ws As Worksheet
Set Ws = Sheets("Universe")
Dim WorksheetNumber As Integer
WorksheetNumber = 1

'Open Workbook2
Workbooks.Open "Workbook2"

' Create Do Loop
    ' Create New Worksheet in Workbook1
ThisWorkbook.Activate
Ws.Range("B11").Select
Do While ActiveCell.Value <> ""
    intTimes = intTimes + 1

    If ActiveCell.Value > 0 Then

        ' Create Output Sheet
        With ThisWorkbook.Sheets.Add(, ActiveSheet)
            Do
                .Name = WorksheetNumber
                If Err = 1004 Then
                    WorksheetNumber = WorksheetNumber + 1
                    Err.Clear
                Else
                    Exit Do
                End If
                DoEvents
            Loop
        End With

        ' Enter Value into Workbook2 from Workbook1
        ThisWorkbook.Sheets("Universe").Range("O11").Copy Destination:=Workbooks("Workbook2").Sheets("Model").Range("E9")

        ' Copy and Paste Column D from Workbook2 to Workbook1
        Workbooks("Workbook2").Worksheets("Model").Range("D14:D500000").Copy
        Workbooks("ThisWorkbook").Worksheets("NEW TAB").Range("D2").PasteSpecial Paste:=xlPasteValues

        'Copy and Paste Column G from Workbook 2 to Workbook1
        Workbooks("Workbook2").Worksheets("Model").Range("G14:G500000").Copy
        Workbooks("ThisWorkbook").Worksheets("NEW TAB").Range("E2").PasteSpecial Paste:=xlPasteValues

        'Copy and Paste Remaining Details from Workbook2 to Workbook1
        Workbooks("Workbook2").Worksheets("Model").Range("L14:U500000").Copy
        Workbooks("ThisWorkbook").Worksheets("NEW TAB").Range("F2").PasteSpecial Paste:=xlPasteValues

    End If

    ActiveCell.Offset(1, 0).Select

    If ActiveCell.Value = "" Then
        intTimes = 0

    End If

Loop

预期结果是,每次运行模型时都会创建一个新选项卡,并且每次都会将模型的输出粘贴到其中。最多将创建500个新标签(然后需要将它们合并到一个标签中)。

0 个答案:

没有答案