Question

我在XL2007上 - Windows 7。

我在下面的代码中需要一个错误处理元素。范围rngburndown中的某些值不作为工作表存在，我需要VBA跳过这些单元格，并将作为工作表存在的行复制到匹配工作表名称中的nextavailable行。

Sub Retrieve_Forecasts()

Dim objWorksheet As Worksheet
Dim rngBurnDown As RANGE
Dim rngCell As RANGE
Dim strPasteToSheet As String
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As RANGE

'DEFINE SOURCE WORKSHEET
Set objWorksheet = ThisWorkbook.Worksheets("Forecasts")

'DEFINE LIST OF FORECASTS - INCLUDING VALUES WHICH MAY NOT EXIST AS WORKSHEETS
Set rngBurnDown = objWorksheet.RANGE("A2:A" & objWorksheet.Cells(Rows.Count, "A").End(xlUp).Row)

'LOOP THROUGH RANGE
For Each rngCell In rngBurnDown.Cells

    objWorksheet.Select

If rngCell.Value <> "" Then
'SELECT ROW
rngCell.EntireRow.Select

'COPY
Selection.Copy

'FIND AND PASTE WHERE WORKSHEET NAME MATCHES FORECAST LIST

Set objNewSheet = ThisWorkbook.Worksheets(rngCell.Value)
objNewSheet.Select

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

您可以使用命令“On Error GoTo 0”忽略所有错误或使用“On Error Resume Next”忽略错误并执行下一条指令，如https://msdn.microsoft.com/en-us/library/5hsw66as.aspx

所示

示例：

For Each rngCell In rngBurnDown.Cells

On Error GoTo 0    

    objWorksheet.Select

If rngCell.Value <> "" Then
'SELECT ROW
rngCell.EntireRow.Select

'COPY
Selection.Copy

'FIND AND PASTE WHERE WORKSHEET NAME MATCHES FORECAST LIST

Set objNewSheet = ThisWorkbook.Worksheets(rngCell.Value)
objNewSheet.Select

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

处理范围表不存在的VBA时出错

1 个答案: