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 
新复制方法的问题会引发错误，因为它可以在上面看到。
预先感谢您的帮助！
这应该做你正在寻找什么：
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
这是我的眼睛自我解释，但如果你有任何问题，只要问:)
尝试replace：
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
此错误经常发生与复制方法有关。 当我有工作表级别的Sub时，我也遇到了这种错误。 尝试提取到一个单独的模块。 此外，它似乎你的Cells的参考被打破。 你可以在Range.Item的文档中find这个解释。 尝试这个
With wskz .Range(.Cells(s, 1), .Cells(s, 250)).Copy End With