Question

我在工作簿Wb1的很多工作表中都有信息，并且此信息始终在F11：F500范围内。我想将此信息转移到工作簿wb的A列中的一个表中。请参见下面的代码。我收到错误在此行rng2.Paste

Option Explicit
Sub NameRisk()

    ' Copy and paste

    Dim wb1 As Workbook
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim rng As Range
    Dim c As Range
    Dim lastrow As Long
    Dim rng2 As Range

    Set wb1 = Application.Workbooks("COMBINED ADD.xls")
    Set wb = Application.Workbooks("NameRiskXtract.xlsm")

    Set ws = wb.Worksheets("Sheet1")


    For Each ws1 In wb1.Sheets
        Set rng = Range("F11:F500")
        For Each c In rng
            If c.Value <> "" Then
                c.Copy
                With ws
                    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                    Set rng2 = ws.Range("A" & lastrow)
                    rng2.Paste
                End With
            End If
        Next c
    Next ws1
End Sub

Answer 1

Range("F11:F500")应该有一个父级工作表；我猜是ws1。您可能正在取消复制操作。最好与目的地一起复制。

...
For Each ws1 In wb1.Sheets
    Set rng = ws1.Range("F11:F500")
    For Each c In rng
        If c.Value <> "" Then
            c.Copy destination:=ws.Cells(ws.Rows.Count, "A").End(xlUp).offset(1, 0)
        End If
    Next c
Next ws
...

Answer 2

您仍然在with语句中。尝试：

For Each ws1 In wb1.Sheets
    Set rng = Range("F11:F500")
    For Each c In rng
        If c.Value <> "" Then
            c.Copy
            With ws
                lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                Set rng2 = .Range("A" & lastrow) " <--- removed ws
                rng2.Paste
            End With
        End If
    Next c
Next ws1

您可能还希望完全避免复制/粘贴，而应使用以下代码段：

For Each ws1 In wb1.Sheets
    For Each c In ws1.Range("F11:F500")
        If c.Value <> "" Then ws.Range("A" & ws.Cells(.Rows.Count, "A").End(xlUp).Row + 1).value = c.value
    Next c
Next ws1

为什么收到“对象不支持此属性方法”？

2 个答案: