VBA Excel Zeilenkopiermethode funktioniert nicht

Question

Ich versuche, eine Zeile in eine andere Arbeitsmappe zu kopieren (nur wenn es eine Übereinstimmung gibt), und ich kann das mit einer einfachen Schleife erreichen, aber ich möchte etwas besser und möglicherweise verwenden schnellere Methode:

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 

Das Problem mit dem neuen Kopierverfahren wirft einen Fehler, wie er oben zu sehen ist.

Vielen Dank im Voraus für Ihre Hilfe!

Answer 1

Dies sollte genau das tun, was Sie suchen:

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 

Es ist selbsterklärend zu meinem Auge, aber wenn Sie irgendwelche Fragen haben, fragen Sie einfach :)

Answer 2

Versuch zu ersetzen:

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

von

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

Oder von:

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 3

Dieser Fehler tritt häufig im Zusammenhang mit Copy-Methoden. Ich stieß auch auf diese Art von Fehler, als ich meine Sub auf Arbeitsblatt-Ebene hatte. Versuchen Sie, es in ein separates Modul zu extrahieren. Auch scheint es, dass Ihre Hinweise auf die Cells sind gebrochen. Sie finden dies in der Dokumentation für Range.Item. Versuchen Sie, diese

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