Question

我正在处理具有多个工作表的excel工作簿，在Sheet8上，我有两列（A和B），它们通过基于列A的vlookup从所有工作表中提取数据，并在其中返回0或> 0答案B列。

我一直试图获取一个宏来复制Sheet8中B列的值大于0的行并将其完全粘贴到Sheet12或新工作簿中，但是代码完全使我困惑了。

下面是我当前正在使用的代码，它将引发运行时错误9：下标超出范围错误。

Sub CSVCreate()

Dim rng As Range
Dim cell As Range
Dim lr As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Sheet8")
Set ws2 = Sheets("Sheet12")

lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row

Set rng = ws1.Range("B1:B" & lr)

For Each cell In rng
    If cell.Value > 0 Then
        cell.EntireRow.Copy
        If ws2.Range("A1").Value = "" Then
            ws2.Range("A1").PasteSpecial xlPasteValues
        Else
            ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        End If
    End If
Next cell

Application.CutCopyMode = False
Range("A1").Select

End Sub

任何帮助将不胜感激！

谢谢，尼克

Answer 1

尝试一下：

Option Explicit

Sub CSVCreate()

    Dim rng As Range, cell As Range
    Dim lr As Long
    Dim ws1 As Worksheet,ws2 As Worksheet

    With ThisWorkbook
        Set ws1 = .Sheets("Sheet8")
        Set ws2 = .Sheets("Sheet12")
    End With

    With ws1

        lr = .Cells(Rows.Count, 1).End(xlUp).Row

        Set rng = .Range("B1:B" & lr)

    End With

    For Each cell In rng

        If cell.Value > 0 Then

            cell.EntireRow.Copy

            With ws2

                If .Range("A1").Value = "" Then
                    .Range("A1").PasteSpecial xlPasteValues
                Else
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                End If

            End With

        End If

    Next cell

    Application.CutCopyMode = False

End Sub

注意：

如果您在以下几行中收到错误消息，则表示您没有此类工作表名称。

Set ws1 = .Sheets("Sheet8")
Set ws2 = .Sheets("Sheet12")

如果值> 0错误，将宏复制并粘贴到新工作表的宏

1 个答案: