VBA excel行复制方法不起作用

Question

我正在尝试将一行复制到另一个工作簿（仅当存在匹配时）并且我可以通过简单的循环完成该操作但我想使用一些更好且可能更快的方法：

Set wbk = Workbooks.Open(FROM)
Set wskz = wbk.Worksheets("Sheet1")

Set wbi = Workbooks.Open(TO)
Set wski = wbi.Worksheets("Sheet1")         


si = 5
Do While wski.Cells(si, 1).Text <> "END"       ' loop through the values in column "A" in the "TO" workbook
    varver = wski.Cells(si, 1).Text            ' data to look up
    s = 5
    Do While wskz.Cells(s, 1).Text <> "END"       ' table where we search for the data in the "FROM" workbook
        If wskz.Cells(s, 1).Text = varver Then Exit Do
        s = s + 1
    Loop

    If wskz.Cells(s, 1).Text <> "END" Then  
    ' I am trying this copy method to replace the loop but it throws an error
       wskz.Range(Cells(s, 1), Cells(s, 250)).Copy Destination:=wski.Range(Cells(si, 1), Cells(si, 250))

    ' this is the working loop:
        'For i = 1 To 250
              '  wskz.Cells(s, i) = wski.Cells(si, i)
               ' i = i + 1
            'End If
        'Next i

新复制方法的问题会引发错误，如上所示。

提前感谢您的帮助！

Answer 1

尝试替换：

wskz.Range(Cells(s, 1), Cells(s, 250)).Copy Destination:=wski.Range(Cells(si, 1), Cells(si, 250))

通过

wskz.Range(wskz.Cells(s, 1), wskz.Cells(s, 250)).Copy Destination:=wski.Range(wski.Cells(si, 1), wski.Cells(si, 250))

或者通过：

Dim Rng1 As Range, Rng2 As Range

Set Rng1 = wskz.Range(wskz.Cells(s, 1), wskz.Cells(s, 250))
Set Rng2 = wski.Range(wski.Cells(si, 1), wski.Cells(si, 250))

Rng1.Copy Rng2

Answer 2

这应该完全符合您的要求：

Sub test()

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.DisplayAlerts = False

  Dim SourceWS As Worksheet, DestWS As Worksheet

  Set SourceWS = Workbooks.Open("FROM").Worksheets("Sheet1")
  Set DestWS = Workbooks.Open("TO").Worksheets("Sheet1")

  Dim runner As Variant, holder As Range

  If IsError(Application.Match("END", DestWS.Range("A5:A" & Rows.Count), 0)) Or IsError(Application.Match("END", SourceWS.Range("A5:A" & Rows.Count), 0)) Then
    SourceWS.Parent.Close False
    DestWS.Parent.Close False
    Exit Sub
  End If

  Set holder = DestWS.Range("A5:A" & Application.Match("END", DestWS.Range("A5:A" & Rows.Count), 0) + 3)

  For Each runner In SourceWS.Range("A5:A" & Application.Match("END", SourceWS.Range("A5:A" & Rows.Count), 0) + 3)
    If IsNumeric(Application.Match(runner.Value, holder, 0)) Then runner.EntireRow.Copy DestWS.Rows(Application.Match(runner.Value, holder, 0) + 4)
  Next

  SourceWS.Parent.Close True
  DestWS.Parent.Close True

  Application.Calculation = xlCalculationAutomatic
  Application.DisplayAlerts = True

End Sub

我的眼睛是自我解释的，但如果您有任何疑问，请问：）

Answer 3

此错误经常发生与复制方法有关。当我在工作表级别上获得Sub时，我也遇到了这种错误。尝试将其提取为单独的模块。 此外，您对Cells的引用似乎已被破坏。您可以在Range.Item的文档中找到此说明。 试试这个

With wskz
    .Range(.Cells(s, 1), .Cells(s, 250)).Copy 
End With