VBA excel行复制方法不'；行不通

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

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

Set wbk=工作簿。打开（从）
设置wskz=wbk.工作表（“表1”）
设置wbi=工作簿。打开（至）
设置wski=wbi.工作表（“表1”）
si=5
在wski.Cells（si，1）.Text“END”循环遍历“TO”工作簿中“A”列中的值时执行此操作
varver=wski.Cells（si，1）.Text要查找的数据
s=5
Do While wskz.Cells（s，1）.Text“END”表，我们在其中搜索“FROM”工作簿中的数据
如果wskz.Cells（s，1）.Text=varver，则退出Do
s=s+1
环
如果wskz.Cells（s，1）.Text“END”，则
'我正在尝试此复制方法来替换循环，但它会抛出一个错误
wskz.Range（单元格（s，1），单元格（s，250））。复制目标：=wski.Range（单元格（si，1），单元格（si，250））
'这是工作循环：
'对于i=1到250
'wskz.Cells（s，i）=wski.Cells（si，i）
‘i=i+1
"完"
“接下来我

新复制方法的问题引发了一个错误，如上所示

---

提前感谢您的帮助

这应该正是您想要的：

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

---

这在我看来是自我解释，但如果你有任何问题，只要问：）

这应该正是你想要的：

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

这在我看来是自我解释，但如果你有任何问题，只要问：）

尝试替换：

wskz.Range(Cells(s, 1), Cells(s, 250)).Copy Destination:=wski.Range(Cells(si, 1), 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

尝试替换：

wskz.Range(Cells(s, 1), Cells(s, 250)).Copy Destination:=wski.Range(Cells(si, 1), 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

---

此错误通常与复制方法相关。当我在工作表级别使用Sub时，我也遇到了这种错误。尝试将其提取到单独的模块。 此外，您对

单元格的引用似乎已中断。您可以在
范围.Item
的文档中找到解释。
试试这个

此错误通常与复制方法有关。当我在工作表级别使用Sub时，我也遇到了这种错误。尝试将其提取到单独的模块。
此外，您对
单元格的引用似乎已中断。您可以在
范围.Item
的文档中找到解释。
试试这个

如回答中所述，原因很可能是因为在为范围设置工作表时，您没有告诉它
.Cells（）
在哪个工作表上。只需将
wskz.
和
wski.
分别添加到
.cells（）
之前。如答案中所述，原因很可能是当您为范围设置工作表时，您没有告诉它
.cells（）
在哪个工作表上。只需在
.cells（）
之前分别添加
wskz.
和
wski.
。Manu的解决方案有效，但只要我有时间，我就会尝试一下，看看它是否比当前的双循环解决方案快。非常感谢。出于某种原因，此代码引发了一个对象错误：Application.Match（“END”，SourceWS.Range（“A5:A”&Rows.Count），0），但我将其替换为“long”lastRow=SourceWS.Cells（SourceWS.Rows.Count，“A”）.END（xlUp）。Row，并修改了For循环：对于SourceWS.Range中的每个运行程序（“A5:A”&lastRow）现在它可以工作了，而且比原来的要快得多。如果你能够改进它，那么这比你简单地复制/粘贴的任何答案都要好：d错误可能是因为没有找到“结束”的地方。。。我假设在你的“末端”下面有你不想解析的数据。。。（作为对您错误的回应）：关于代码，我只有一个问题：当您设置holder:set holder=DestWS.Range（“A5:a”和Application.Match（“VÉGE”），DestWS.Range（“A5:a”和Rows.Count），0）+3）为什么要在“Match”结果中添加3？Manu的解决方案有效，但只要我有时间，我就要试试这个，看看它是否比当前的双循环解决方案快。非常感谢。出于某种原因，此代码引发了一个对象错误：Application.Match（“END”，SourceWS.Range（“A5:A”&Rows.Count），0），但我将其替换为“long”lastRow=SourceWS.Cells（SourceWS.Rows.Count，“A”）.END（xlUp）。Row，并修改了For循环：对于SourceWS.Range中的每个运行程序（“A5:A”&lastRow）现在它可以工作了，而且比原来的要快得多。如果你能够改进它，那么这比你简单地复制/粘贴的任何答案都要好：d错误可能是因为没有找到“结束”的地方。。。我假设在你的“末端”下面有你不想解析的数据。。。（作为对您错误的回应）：关于代码，我只有一个问题：当您设置holder:set holder=DestWS.Range（“A5:a”和Application.Match（“VÉGE”，DestWS.Range（“A5:a”和Rows.Count），0）+3）为什么要在“Match”结果中添加3？