Question

我是excel的新手，我正在尝试将符合条件（代码）的数据传输到另一张工作表。

错误本身出现在

行上

a = Worksheets("ToExtract").Cells(Rows.Count, 1).End(xlUp).Row

我得到了一个

运行时错误9。

Private Sub CommandButton1_Click()

    a = Worksheets("ToExtract").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To a

        If Worksheets("ToExtract").Cells(i, 3).Value = "20040155" Then

            Worksheets("ToExtract").Rows(i).Copy
            Worksheets("Sheet2").Activate
            b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("Sheet2").Cells(b + 1, 1).Select
            ActiveSheet.Paste
            Worksheets("ToExtract").Activate

        End If
    Next

    Application.CutCopyMode = False
    ThisWorkbook.Worksheets("ToExtract").Cells(1, 1).Select

End Sub

Answer 1

试试这个，我编辑了你的代码。它对我来说很好用：

Private Sub CommandButton1_Click()

'Declare your workbook
Dim wb As Workbook
Set wb = ThisWorkbook

'Declare all your worksheet
Dim sh_extract, sh_tocopy As Worksheet
Set sh_extract = wb.Worksheets("Sheet1")
Set sh_tocopy = wb.Worksheets("Sheet2")

Dim a, b As Long
a = sh_extract.Range("B" & Rows.Count).End(xlUp).Row 'Change column letter if you need to check other column to have last row

    For i = 2 To a
    'If sh_extract.Cells(i, 2).Value = "20040155" or sh_extract.Cells(i, 2).Value = "23358308" Then 
        If sh_extract.Cells(i, 2).Value = "20040155" Then 
            'copy the row
            sh_extract.Rows(i).Copy

            'define the last row of 2nd sheet
            b = sh_tocopy.Range("B" & Rows.Count).End(xlUp).Row + 1 'Change column letter if you need to check other column to have last row


            'Copy the row
            sh_tocopy.Rows(b).PasteSpecial xlPasteValues

        End If
    Next

    Application.CutCopyMode = False
    sh_extract.Cells(1, 1).Select

End Sub

尝试将符合条件的特定数据行复制到新工作表

1 个答案: