AW: Bestimmte Zeilen kopieren
23.11.2015 21:32:09
Matthias
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