VBARuntime错误1004

时间:2017-12-06 20:10:14

标签: excel excel-vba vba

我正在尝试编写一个宏,它将按两个条件过滤一组数据,然后将该数据复制并粘贴到新工作表中。我有它工作,以便它创建新工作表并添加标题行但我不断收到以下If语句的运行时错误,我不能为我的生活找出原因。

If sh.Cells(nRows, 8).Value = "PS" And sh.Cells(nRows, 11).Value = "Key Player" Then

有人可以帮忙吗?我已经复制了下面的完整代码。

Option Explicit
Sub CopyPSStakeholders()
Dim sh      As Worksheet
Dim DestSh  As Worksheet
Dim StartRow As Long
Dim i       As Integer
Dim headers() As Variant
Dim nRows   As Long

Dim LastRow As Long

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

'Delete the PS Stakeholders sheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next

ActiveWorkbook.Worksheets("PS Stakeholders").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a new PS Stakeholders worksheet.
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "PS Stakeholders"

Set sh = ActiveWorkbook.Worksheets("Stakeholders")

'Insert header row.
headers() = Array("Key Player - Post", "Key Player - UID", "Actively Involve - Post", "Actively Involve - UID", "Keep Informed - Post", "Keep Informed - UID")

With DestSh.Cells
    .Rows(1).Value = ""      'This will clear out row 1
    For i = LBound(headers()) To UBound(headers())
        .Cells(1, 1 + i).Value = headers(i)
    Next i
    .Rows(1).Font.Bold = True
End With

'Count the last used row of data
LastRow = Cells(Rows.Count, 1).End(xlUp).Row

'Set the first row of data
nRows = 2

'Filter and copy/paste
With sh.Cells
    Do
        If sh.Cells(nRows, 8).Value = "PS" And sh.Cells(nRows, 11).Value = "Key Player" Then
            DestSh.Cells(nRows, 1).Value = sh.Cells(nRows, 3).Value
        End If
        nRows = nRows + 1
    Loop Until nRows = LastRow
End With

ExitTheSub:
Application.Goto DestSh.Cells(1)

' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

With Sheets("Active")
    .Visible = True
    .Activate
End With

End Sub

0 个答案:

没有答案