Bestimmte Zeilen kopieren

Bild

Betrifft: Bestimmte Zeilen kopieren
von: Gerald
Geschrieben am: 23.11.2015 15:07:28

Hallo Forum,
folgendes würde ich gerne mit VBA lösen:
Im Tabellenblatt (Budget) stehen in Spalte D ab Zeile 2 die Bestellnummern. Die Bestellnummern sind mehrmals vorhanden, und nicht alle Zellen sind gefüllt. In Spalte N ab Zeile 1, stehen eingefügte Bestellnummern (keine Leerzellen).
Nun soll Spalte N mit Spalte D verglichen werden. Tritt eine Übereinstimmung in Spalte D auf, soll jeweils die Zeile C-J in ein anderes Workbook, Tabelle (Budget_HW), Spalte B-I eingefügt werden.
In dem Tabellenblatt (Budget_HW) sind alle Zellen gefüllt, und die letzte gefüllte Zeile ist verbunden (A-I) und mit Text gefüllt. Spalte A ist fortlaufend nummeriert.
Einfügen heißt, wenn die letzte beschriebene Zeile 1200 ist, dann soll die erste kopierte Zeile in 1119 eingefügt werden.
Vielen Dank,
Gerald

Bild

Betrifft: AW: Bestimmte Zeilen kopieren
von: Matthias
Geschrieben am: 23.11.2015 21:01:29
Hallo Gerald,
ich habe dazu eine Frage:
Was genau meinst du mit Übereinstiummung zws. Spalte N und D?
Wenn die Bestellnummer (Spalte D) in Zeile XY in deiner Liste der Bestellnummern (Spalte N) vorkommt (egal welche Zeile), oder wenn die Nummern auf der selben Zeile übereinstimmen?
lg Matthias

Bild

Betrifft: AW: Bestimmte Zeilen kopieren
von: Matthias
Geschrieben am: 23.11.2015 21:32:09
Bitte probier mal diesen Code aus, aber ändere vorher den Pfad der Zieldatei:

Sub DenkDirNenHübscherenNamenAus()
Dim wksQ As Worksheet, wksZ As Worksheet    'Quell- und Zielsheet
Dim wkbZ As Workbook                        'Zieldatei
Dim lZeileQ As Long, lZeileZ As Long        'letzte beschriebene Zeile
Dim bFilter As Boolean
Application.ScreenUpdating = False
'Bezüge
Set wksQ = ThisWorkbook.Sheets("Budget") 'Quelle
Set wkbZ = Workbooks.Open("D:\Excel\Test2.xlsm")
Set wksZ = wkbZ.Sheets("Budget_HW")
With wksQ
    'vorhandenen Autofilter entfernen
    If .AutoFilterMode Then
        .Cells.AutoFilter
        bFilter = True
    End If
    'Hilfsspalte einfügen, Formel eintragen und runter ziehen
    lZeileQ = .Cells(.Rows.Count, 4).End(xlUp).Row
    .Columns("A").Insert Shift:=xlToRight
    .Range("A2").FormulaR1C1 = "=IF(RC[4]=RC[14],1,0)"  '*Formel*
    '   "=IF(IFERROR(MATCH(RC[4],C[14],0),0)>0,1,0)"
    .Range("A2").AutoFill Destination:=.Range("A2:A" & lZeileQ), Type:=xlFillDefault
    
    'Hilfsspalte filtern
    .Cells.AutoFilter
    .Range("A:A").AutoFilter Field:=1, Criteria1:="=1"
    
    'Im Zielsheet Zeilen einfügen, Filterergebnis kopieren
    With wksZ
        lZeileZ = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(lZeileZ, 1), .Cells(WorksheetFunction.Sum(wksQ.Range("A2:A" & lZeileQ)) _
        + lZeileZ - 1, 1)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End With
    .Range("D2:K" & lZeileQ).Copy Destination:=wksZ.Range("B" & lZeileZ)
    'Autofilter wieder entfernen wenn ursprünglich keiner vorhanden war
    If bFilter = False Then .Cells.AutoFilter
End With
'Aufräumen
wkbZ.Save
wkbZ.Close
wksQ.Columns("A").Delete 'Hiflsspalte löschen
Application.ScreenUpdating = True
End Sub
Hier wird im Grunde nur eine Hilfsspalte vor A eingefügt und dort eine Formel eingetragen und runtergezogen. Diese gibt Eins zurück wenn es eine Übereinstimmung gibt, ansonsten Null. Die Hilfsspalte wird dann gefiltert und alle verbliebenen Zeilen kopiert entsprechend der Aufgabenstellung.
Wie bereits erwähnt bin ich nicht ganz schlüssig wie genau deine Übereinstimmung definiert ist. Daher habe ich mit der Variante "wenn die Nummern auf der selben Zeile übereinstimmen" gearbeitet. Sollte das nicht dein Wunsch gewesen sein, so habe ich für die zweite Variante die Formel in der Zeile darunter als Kommentar vermerkt. Dies ist dann durch dich einfach zu ersetzen.
lg Matthias

Bild

Betrifft: AW: Bestimmte Zeilen kopieren
von: Gerald
Geschrieben am: 27.11.2015 08:27:20
Hallo Matthias,
danke für die schnelle Rückmeldung!!
Mit Übereinstimmung meine ich, dass in Spalte N1:N Bestellnummer stehen (keine doppelt vorhanden), die
mit Spalte D2:D verglichen werden. Dabei können in Spalte D die Bestellnummern mehrmals vorkommen.
Es soll N1 mit D2:D verglichen werden. Ist in Spalte D die Bestellnummer vorhanden, dann Zeile C bis J in das Tabellenblatt Budget_HW einfügen.
Dann das gleiche mit N2, usw.
z.B.:
........D..........................N
.Bestellnummer........Bestell-Nr.xx
Bestell-Nr.01..............Bestell-Nr.xy
Bestell-Nr.02..............Bestell-Nr.01
Bestell-Nr.03..............Bestell-Nr.04
Bestell-Nr.01..............Bestell-Nr.03
Bestell-Nr.01..............Bestell-Nr.05
Tabellenblatt Budget_HW:
....C
...
...
Bestell-Nr.01
Bestell-Nr.01
Bestell-Nr.01
Bestell-Nr.03
verbundene Zeile A:I
Hoffe ich konnte es einigermaßen erklären.
Dein Makro kopiert im Moment alle Zeilen.
Gruß,
Gerald

Bild

Betrifft: AW: Bestimmte Zeilen kopieren
von: Gerald
Geschrieben am: 24.11.2015 09:48:12
Hallo Matthias,
danke für die schnelle Rückmeldung!!
Mit Übereinstimmung meine ich, dass in Spalte N1:N Bestellnummer stehen (keine doppelt vorhanden), die
mit Spalte D2:D verglichen werden. Dabei können in Spalte D die Bestellnummern mehrmals vorkommen.
Es soll N1 mit D2:D verglichen werden. Ist in Spalte D die Bestellnummer vorhanden, dann Zeile C bis J in das Tabellenblatt Budget_HW einfügen.
Dann das gleiche mit N2, usw.
z.B.:
........D..........................N
.Bestellnummer........Bestell-Nr.xx
Bestell-Nr.01..............Bestell-Nr.xy
Bestell-Nr.02..............Bestell-Nr.01
Bestell-Nr.03..............Bestell-Nr.04
Bestell-Nr.01..............Bestell-Nr.03
Bestell-Nr.01..............Bestell-Nr.05
Tabellenblatt Budget_HW:
....C
...
...
Bestell-Nr.01
Bestell-Nr.01
Bestell-Nr.01
Bestell-Nr.03
verbundene Zeile A:I
Hoffe ich konnte es einigermaßen erklären.
Dein Makro kopiert im Moment alle Zeilen.
Gruß,
Gerald

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Bestimmte Zeilen kopieren"