我正在尝试编写一个宏,它将按两个条件过滤一组数据,然后将该数据复制并粘贴到新工作表中。我有它工作,以便它创建新工作表并添加标题行但我不断收到以下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