«Ошибка времени выполнения 9» при копировании строк с одного листа на другие.

Question

Использование Excel 2007 и попытка объединить VBA, который будет копировать строки из листа, называемого Forecasts in, в различные существующие листы, где имя рабочего листа соответствует значению 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` 

проверена и работает.