Question

使用Excel 2007，并尝试将VBA从一张名为Forecasts的工作表复制到各种现有工作表中，其中工作表名称与预测表中的值A2：A匹配。

当我运行以下内容时，我得到运行时错误9，调试模式突出显示以下行

Set objNewSheet = ThisWorkbook.Worksheets("Sheet" & rngCell.Value)

完整的代码是：

Sub Retrieve_Forecasts()

Dim objWorksheet As Worksheet
Dim rngBurnDown As Range
Dim rngCell As Range
Dim strPasteToSheet As String

'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range

'Define the worksheet with our data
Set objWorksheet = ThisWorkbook.Worksheets("Forecasts")

'Dynamically define the range to the last cell.
'If we are not starting in A1, then change as appropriate
Set rngBurnDown = objWorksheet.Range("A2:A" & objWorksheet.Cells(Rows.Count, "A").End(xlUp).Row)

'Now loop through all the cells in the range
For Each rngCell In rngBurnDown.Cells

    objWorksheet.Select

    If rngCell.Value <> "" Then
        'select the entire row
        rngCell.EntireRow.Select

        'copy the selection
        Selection.Copy

        'Now identify and select the new sheet to paste into
        Set objNewSheet = ThisWorkbook.Worksheets("Sheet" & rngCell.Value)
        objNewSheet.Select

        'Looking at your initial question, I believe you are trying to find the next     available row
        Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)


        Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
        ActiveSheet.Paste
    End If

Next rngCell

objWorksheet.Select
objWorksheet.Cells(1, 1).Select

End Sub

有人可以帮忙吗？

Answer 1

代码试图激活名为“Sheet10000001”的工作表，工作表标题只是“10000001”。

修改后的代码

Sub Retrieve_Forecasts()

Dim objWorksheet As Worksheet
Dim rngBurnDown As Range
Dim rngCell As Range
Dim strPasteToSheet As String

'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range

'Define the worksheet with our data
Set objWorksheet = ThisWorkbook.Worksheets("Forecasts")

'Dynamically define the range to the last cell.
'If we are not starting in A1, then change as appropriate
Set rngBurnDown = objWorksheet.Range("A2:A" & objWorksheet.Cells(Rows.Count, "A").End(xlUp).Row)

'Now loop through all the cells in the range
For Each rngCell In rngBurnDown.Cells

objWorksheet.Select

If rngCell.Value <> "" Then
    'select the entire row
    rngCell.EntireRow.Select

    'copy the selection
    Selection.Copy

    'Now identify and select the new sheet to paste into
    Set objNewSheet = ThisWorkbook.Worksheets(rngCell.Value)
    objNewSheet.Select

    'next available row
    Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)


    Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
    ActiveSheet.Paste
End If

Next rngCell

objWorksheet.Select
objWorksheet.Cells(1, 1).Select

End Sub`

经过测试和工作。

＆＃34;运行时错误9＆＃34;将行从一个工作表复制到其他工作表时

1 个答案: