VBA excel行復制方法不起作用

我想複製一行到另一個工作簿（只有當有匹配時），我可以用一個簡單的循環完成，但我想用一些更好和可能較快的方法：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

與新的複製方法的問題拋出，因爲它可以被上面看到一個錯誤。

非常感謝您的幫助！

來源

2016-05-01 elwindly

由於在答案中提到，其原因很可能是因爲您同時設置了範圍的工作，你沒有告訴它該工作表中的'.Cells（）'上。只需在'.cells（）'之前分別添加'wskz.'和'wski.'。 – BruceWayne

這應該做的正是你在找什麼：

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

它是自我解釋我的眼睛，但如果你有任何問題，只是問:)

來源

2016-05-01 21:40:02

Manu的解決方案很有用，但只要我有時間，我會試試看看它是否比當前的兩個循環解決方案更快。謝謝！ – elwindly

出於某種原因，此代碼會拋出一個對象錯誤：Application.Match（「END」，SourceWS.Range（「A5：A」＆Rows.Count），0）但我用「long」替換它lastRow = SourceWS.Cells （SourceWS.Rows.Count，「A」）。End（xlUp）.Row並修改For循環：For Each runner In SourceWS.Range（「A5：A」＆lastRow）現在它的工作原理比原來的更快 – elwindly

如果你能夠改善它，那麼這比任何你只需複製/粘貼的答案要好：D –

試圖取代：

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

來源

2016-05-01 21:57:11 manu

此錯誤通常與Copy-Methods有關。當我有工作表級別的Sub時，我也遇到了這種錯誤。嘗試將其提取到單獨的模塊。此外，它似乎是你的參考Cells壞了。你可以在Range.Item的文檔中找到這個解釋。試試這個

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

來源

2016-05-01 22:00:50

VBA excel行復制方法不起作用

回答

相關問題