Question

我对VBA世界还很陌生，并且负责编写一些代码，这些代码将逐步通过A列中的公司名称，当找到该名称时，代码会将相关行复制并粘贴到新的创建了工作簿。然后应继续使用下一个名称，依此类推。在测试过程中代码工作但是我已经进入今天，我现在在行rngG.Select上获得对象变量错误

任何人都可以提供帮助，因为我已经看了一个小时了，现在我完全不知所措了吗？

Sub CrystalUtilitesLtd()


Dim Wk As Workbook
Dim c As Range
Dim rngG As Range

Application.DisplayAlerts = False

For Each c In Intersect(ActiveSheet.UsedRange, Columns("a"))
    If c = "3rd Party - Crystal Utilities Ltd" Then
        If rngG Is Nothing Then Set rngG = c.EntireRow
        Set rngG = Union(rngG, c.EntireRow)
    End If
Next c
rngG.Select
Selection.Copy

Workbooks.Open "I:\Data\OMR8293\General\Ops Team\Customer Transfer Team\TPI Registration Reporting\TPI Registration Data Template1.xlsx"
Range("A2").Select
Selection.PasteSpecial xlPasteValues
Range("A1:AG1").EntireColumn.AutoFit
ActiveWorkbook.SaveAs ("I:\Data\OMR8293\General\Ops Team\Customer Transfer Team\TPI Registration Reporting\Crystal Utilities Ltd\Registrations_1010112503_" _
                        & Format(Now(), "YYYYMMDD") & ".xlsx")
ActiveWorkbook.Close

Call EnergyAnalystUK

Application.DisplayAlerts = True

End Sub

Answer 1

替换以下两行代码......

rngG.Select
Selection.Copy

使用这些行

If Not rngG Is Nothing Then
    rngG.Copy
Else
    MsgBox "No range to copy.", vbExclamation
    Exit Sub
End If

原因是如果 c <> "3rd Party - Crystal Utilities Ltd"那么rngG对象永远不会被赋予范围，所以它仍然是Nothing，因为你不能做Nothing.Select您将获得对象变量或未设置块错误。

通过上述更改，您的完整代码将是这样的......

Sub CrystalUtilitesLtd()


Dim Wk As Workbook
Dim c As Range
Dim rngG As Range

Application.DisplayAlerts = False

For Each c In Intersect(ActiveSheet.UsedRange, Columns("a"))
    If LCase(VBA.Trim(c)) = "3rd party - crystal utilities ltd" Then
        If rngG Is Nothing Then Set rngG = c.EntireRow
        Set rngG = Union(rngG, c.EntireRow)
    End If
Next c

If Not rngG Is Nothing Then
    rngG.Copy
    Workbooks.Open "I:\Data\OMR8293\General\Ops Team\Customer Transfer Team\TPI Registration Reporting\TPI Registration Data Template1.xlsx"
    Range("A2").Select
    Selection.PasteSpecial xlPasteValues
    Range("A1:AG1").EntireColumn.AutoFit
    ActiveWorkbook.SaveAs ("I:\Data\OMR8293\General\Ops Team\Customer Transfer Team\TPI Registration Reporting\Crystal Utilities Ltd\Registrations_1010112503_" _
                            & Format(Now(), "YYYYMMDD") & ".xlsx")
    ActiveWorkbook.Close
Else
    MsgBox "No range to copy.", vbExclamation
End If

Call EnergyAnalystUK

Application.DisplayAlerts = True

End Sub

未设置对象变量（错误91）

1 个答案: