Question

基本上，如果在Sheet1中，第I列中的单元格不是空白，则将单元格A，B，I和L复制到下一个可用空白行的第2页。循环到Sheet1上的行结束。

我一直在.Copy行收到错误9或450代码。

我已将模块连接到Sheet2上的按钮。这可能是原因吗？

或者我应该使用与CopyPaste功能不同的东西吗？

这是我试图开始工作的代码。

Option Explicit

Sub copyPositiveNotesData()

    Dim erow As Long, lastrow As Long, i As Long

    lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastrow
        If Sheet1.Cells(i, "I") <> "" Then
            Worksheets("Sheet1").Activate

            ' *** next line gives Err#450 "Wrong # of arguments or invalid property assignments" ****
            Worksheets("Sheet1").Range(Cells(i, "A"), Cells(i, "B"), _
                Cells(i, "I"), Cells(i, "L")).Copy

            Worksheets("Sheet2").Activate
            erow = WorkSheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            ActiveSheet.Paste Destination:=Worksheets("Sheet2"). _
                Range(Cells(i, "A"), Cells(i, "B"), Cells(i, "C"), Cells(i, "D"))
            Worksheets("sheet1").Activate
        End If
    Next i
    Application.CutCopyMode = False

End Sub

Answer 1

您需要使用Application.Union连续合并4个单元格，类似下面的代码：

完整修改后的代码

Option Explicit

Sub copyPositiveNotesData()

Dim erow As Long, lastrow As Long, i As Long
Dim RngCopy As Range

With Worksheets("Sheet1")
    lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastrow
        If Trim(.Cells(i, "I").Value) <> "" Then
            Set RngCopy = Application.Union(.Range("A" & i), .Range("B" & i), .Range("I" & i), .Range("L" & i))              
            RngCopy.Copy ' copy the Union range

            ' get next empty row in "Sheet2"
            erow = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            ' paste in the next empty row
            Worksheets("Sheet2").Range("A" & erow).PasteSpecial xlPasteAll
        End If
    Next i
End With

Application.CutCopyMode = False

End Sub

Answer 2

你可以试试这个（未经测试）

Option Explicit

Sub copyPositiveNotesData()
    Intersect (Sheet1.Range("I2", Sheet1.Cells(.Rows.Count, "I").End(xlUp)).SpeciallCells(xlCellTypeConstants).EntireRow, Sheet1.Range("A:A", "B:B", "I:I", "L:L")).Copy Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Offset(1, 0)
End Sub

Answer 3

看起来问题是您尝试一次复制多个不受支持的单元格（尝试在实际工作表中手动执行相同操作）。您需要复制单个单元格或连续范围。您可以执行4次复制/粘贴，也可以直接在目标工作表中设置值。

尝试将复制/粘贴更改为以下（未经测试）：

Sub copyPositiveNotesData()
    Dim erow As Long, lastrow As Long, i As Long, ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastrow
        If Sheet1.Cells(i, "I") <> "" Then
           With ws2

               .Range("A" & i).Value = ws1.Range("A" & i).Value
               .Range("B" & i).Value = ws1.Range("B" & i).Value
               .Range("I" & i).Value = ws1.Range("I" & i).Value
               .Range("L" & i).Value = ws1.Range("L" & i).Value

           End With

       End If
    Next i

End Sub

Excel - 如果单元格不为空，则将特定行单元格复制到工作表2

3 个答案: