Excel-Makro: Kopieren von Zeilenwerten aus einem Arbeitsblatt an eine bestimmte Stelle in einem anderen Arbeitsblatt, basierend auf Kriterien

Question

Ich habe erst seit ca. 4 Monaten mit Makros in Excel gearbeitet und habe mich im Wesentlichen selbst gelehrt, indem ich vorhandenen Code gefunden und herausgefunden habe wie es funktioniert. Ich bin jetzt ein bisschen fest.

Ich habe einen Bericht in einer Excel-Arbeitsmappe. Ich muss die Daten über mehrere Arbeitsblätter (innerhalb derselben Arbeitsmappe) kopieren, basierend auf den Daten, die in Spalte D erscheinen. Das heißt, ich muss die gesamte Zeile kopieren, in der Spalte D bestimmte Kriterien erfüllt. Das ursprüngliche Arbeitsblatt enthält Formeln, aber ich möchte nur die Werte angezeigt werden, wenn die Daten kopiert werden.

ich war in der Lage, die Daten über, zu kopieren, aber ich habe zwei Probleme: 1) die Formeln kopieren über, nicht nur die Werte 2) die Daten an der Zelle A2 in das neuen Arbeitsblatt erscheinen, aber ich brauche Es beginnt bei Zelle A5

Ich bin dies als eine Vorlage einrichten, wie der Hauptbericht jeden Monat ausgeführt werden und aufgeteilt werden muss, so dass der Bereich, aus dem ich kopiere nicht konstant sein wird. Dies ist ein Beispiel für den Code ich bin derzeit mit:

Sub RefreshSheets() 

    Sheets("ORIGIN").Select 
    Dim lr As Long, lr2 As Long, r As Long 
    lr = Sheets("ORIGIN").Cells(Rows.Count, "A").End(xlUp).Row 
    lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row 

    For r = lr To 2 Step -1 
     If Range("D" & r).Value = "movedata" Then 
      Rows(r).Copy Destination:=Sheets("DESTINATION").Range("A" & lr2 + 1) 
      lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row 
     End If 


    Next r 

    End Sub 

ich versucht habe, den Zusatz ".PasteSpecial Paste: = xlPasteValues" nach ".Range ("A" & lr2 + 1)", aber ich habe eine Kompilierfehler (erwartet: Ende der Anweisung). Ich bin sicher, ich habe etwas offensichtlich übersehen (das ist, was ich für die Verwendung von Code, den ich noch nicht vollständig verstehe), aber nichts, was ich bisher versucht habe funktioniert hat.

Jeder Rat würde sehr geschätzt werden.

Answer 1

Die erste Version verwendet eine For-Schleife (es kann mit vielen Reihen langsam)

Option Explicit 

Public Sub RefreshSheets() 
    Dim wsO As Worksheet, wsD As Worksheet, lrO As Long, lrD As Long, r As Long 

    Set wsO = ThisWorkbook.Sheets("ORIGIN") 
    Set wsD = ThisWorkbook.Sheets("DESTINATION") 
    lrO = wsO.Cells(Rows.Count, "A").End(xlUp).Row 
    lrD = wsD.Cells(Rows.Count, "A").End(xlUp).Row 

    If lrD < 5 Then lrD = 5 

    For r = lrO To 2 Step -1 
     If wsO.Range("D" & r).Value2 = "movedata" Then 
      wsO.Rows(r).Copy 
      wsD.Range("A" & lrD + 1).PasteSpecial xlPasteValues 
      lrD = lrD + 1 
     End If 
    Next 
End Sub 

---

Diese version verwendet einen AutoFilter, um alle Zeilen mit "movedata" gleichzeitig zu kopieren:

Public Sub RefreshSheetsFast() 
    Dim wsO As Worksheet, wsD As Worksheet, lrD As Long 

    Set wsO = ThisWorkbook.Sheets("ORIGIN") 
    Set wsD = ThisWorkbook.Sheets("DESTINATION") 
    lrD = wsD.Cells(Rows.Count, "A").End(xlUp).Row 

    If lrD < 5 Then lrD = 5 'Makes sure the first row on DESTINATION sheet is >=5 

    If Not wsO.AutoFilter Is Nothing Then wsO.UsedRange.AutoFilter 
    With wsO.UsedRange 
     .Columns(4).AutoFilter Field:=1, Criteria1:="movedata" 
     .Offset(1).Resize(.Rows.Count - 1).Copy  'Excludes the header (row 1) 
    End With 
    wsD.Range("A" & lrD + 1).PasteSpecial xlPasteValues 

    Application.CutCopyMode = False 
    wsO.UsedRange.AutoFilter 'Removes the "movedata" filter 
End Sub 

Answer 2

das Kopieren und Einfügen auszuführen als zwei getrennte Anfragen:

Sub RefreshSheets() 
    Sheets("ORIGIN").Select 
    Dim lr As Long, lr2 As Long, r As Long 
    lr = Sheets("ORIGIN").Cells(Rows.Count, "A").End(xlUp).Row 
    lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row 

    For r = lr To 2 Step -1 
     If Range("D" & r).Value = "movedata" Then 
      Rows(r).Copy 
      Sheets("DESTINATION").Range("A" & lr2 + 1).PasteSpecial xlPasteValues 
      lr2 = Sheets("DESTINATION").Cells(Rows.Count, "A").End(xlUp).Row 
     End If 
    Next r 
End Sub