Question

我的Excel VBA代码存在问题。当注释掉的块处于活动状态时，我只获得1004 error。

错误结果：

创建数组中的第一个工作表，粘贴标题行并正确格式化
创建了第二张表，没有标题行粘贴
错误会在此时停止脚本 - ＆gt;没有创建其他工作表

我无法弄清问题是什么，有人可以帮忙吗？

Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("AGESTOCK")

Dim newSheets(1 To 4) As String
newSheets(1) = "CHEM - ALSO"
newSheets(2) = "LBS - LBLA"
newSheets(3) = "LBS - LBFG"
newSheets(4) = "Chemicals"
Dim sheetName As Variant

'Copy Header Row from ws1
ws1.Cells(1, 1).EntireRow.Copy

'Create New Worksheets
For Each sheetName In newSheets
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = sheetName

    'Paste Header Row
    ActiveSheet.Cells(1, 1).Select
    ActiveSheet.Paste

    ' Autofit Columns & Zoom & Scroll
    ActiveWindow.Zoom = 90
    ActiveSheet.Columns("A:Y").AutoFit
    ActiveSheet.Columns("B").ColumnWidth = 60  'Description
    ActiveSheet.Columns("E").ColumnWidth = 12  'WAS
    ActiveSheet.Columns("F").ColumnWidth = 12  'NOW

    'THIS IS THE SECTION THAT BREAKS IT
    'Format WAS, NOW, AVGCOST, VALUE to CURRENCY  
'    ActiveSheet.Columns("E").NumberFormat = "$#,##0.00"  'WAS
'    ActiveSheet.Columns("F").NumberFormat = "$#,##0.00"  'NOW
'    ActiveSheet.Columns("H").NumberFormat = "$#,##0.00"  'AvgCost
'    ActiveSheet.Columns("L").NumberFormat = "$#,##0.00"  'Value

Next sheetName
ws1.Activate

Answer 1

这基本上是因为Excel从VBA复制和粘贴是可怕的。我建议使用以下作为您的宏。请注意，我指定范围，然后将其直接复制到目标（不会发生混乱选择）。这使得事情更加可靠，因为Excel处理整个复制操作，而不是Windows。我认为。当然，让事情对我有用。

Public Sub Test()
    Dim newSheets(1 To 4) As String
    newSheets(1) = "CHEM - ALSO"
    newSheets(2) = "LBS - LBLA"
    newSheets(3) = "LBS - LBFG"
    newSheets(4) = "Chemicals"
    Dim sheetName As Variant
    Dim ws1 As Excel.Worksheet
    Dim rngCopyTarget As Excel.Range
    Set ws1 = ThisWorkbook.Sheets(1)

    'Copy Header Row from ws1

    Set rngCopyTarget = ws1.Cells(1, 1).EntireRow
    'Create New Worksheets
    For Each sheetName In newSheets
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = sheetName

        'Paste Header Row
        rngCopyTarget.Copy ActiveSheet.Range(rngCopyTarget.Address)

        ' Autofit Columns & Zoom & Scroll
        ActiveWindow.Zoom = 90
        ActiveSheet.Columns("A:Y").AutoFit
        ActiveSheet.Columns("B").ColumnWidth = 60  'Description
        ActiveSheet.Columns("E").ColumnWidth = 12  'WAS
        ActiveSheet.Columns("F").ColumnWidth = 12  'NOW

        'THIS IS THE SECTION THAT BREAKS IT
        'Format WAS, NOW, AVGCOST, VALUE to CURRENCY
        ActiveSheet.Columns("E").NumberFormat = "$#,##0.00"  'WAS
        ActiveSheet.Columns("F").NumberFormat = "$#,##0.00"  'NOW
        ActiveSheet.Columns("H").NumberFormat = "$#,##0.00"  'AvgCost
        ActiveSheet.Columns("L").NumberFormat = "$#,##0.00"  'Value

    Next sheetName
    ws1.Activate
End Sub

Answer 2

@Sorceri在他的评论中提出了这个想法，但由于它没有作为答案发布，我将对其进行扩展。

您的代码正在复制标题详细信息，然后才能进入循环。如果设置屏幕，则可以看到Excel和VBA编辑器窗口。在VBA编辑器中，单击代码中的任意位置，然后按 - 注意黄色行突出显示，因为这是要执行的下一行代码。

在Excel窗口中观看更改时，按住 F8 。＆＃34;行进的蚂蚁＆＃34;将在复制命令后出现。当你有 F8 ＆＃39; d到

时

ActiveSheet.Columns("E").NumberFormat = "$#,##0.00"

然后换回Excel并选择AGESTOCK表 - 行进的蚂蚁将在那里！

在VBA编辑器中按F8 和蚂蚁消失意味着剪贴板已被清除。某些Excel操作会清除剪贴板，但显然设置列宽不是其中之一，并且在一定范围内更改单元格格式肯定是。我测试了它＆＃34;生活＆＃34;。

然后解决方案是移动你的：

ws1.Cells(1, 1).EntireRow.Copy

进入你的循环：

'*** DON'T Copy Header Row from ws1 yet ***
'ws1.Cells(1, 1).EntireRow.Copy '**copies contents before 1st loop and is emptied
'when you change the cell format ***

'Create New Worksheets
For Each sheetName In newSheets
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = sheetName

    'Copy Header Row from ws1
    ws1.Cells(1, 1).EntireRow.Copy

    'Paste Header Row
    ActiveSheet.Cells(1, 1).Select
    ActiveSheet.Paste '

Excel VBA - 在raise 1004 Error中创建新工作表并粘贴东西

2 个答案: