Inhalt ab leerer Zeile zu Spalten hinzufügen
18.04.2015 12:27:34
Michael Reuters
Hallo,
anbei mein VBA Code. Ich möchte bestimmte Spalten aus dem Tabellenblatt "PivotTable" in das Tabellenblatt "02_b02_articleunit" kopieren. Das klappt soweit auch ganz gut. Wenn ich allerdings Sub b02_articleunit1() ausgeführt habe und anschließend Sub b02_articleunit0() ausführe, wird mir der Inhalt von Sub b02_articleunit1() überschrieben. In beiden Subs setze ich verschiedene Filter auf die PivotTable und kopiere anschließend den Inhalt. Ich denke mein Fehler ist, dass ich im Range jeweils die falschen Zeilen angebe. Kann mir jemand helfen, den Code zu optimieren? Vielen Dank im Voraus!
Sub b02_articleunit1()
On Error GoTo fehler1:
Dim pf As PivotField
Set pf = Sheets("PivotTable").PivotTables("PivotTable1").PivotFields("Abgleich_ME1_ME2")
'Remove existing filter
pf.ClearAllFilters
pf.CurrentPage = "1"
'Finde letzte Zeile
With Sheets("PivotTable")
letzteZeile = .Range("A" & .Rows.Count).End(xlUp).Row
End With
'1 einfügen
Sheets("02_b02_articleunit").Range("A2:A" & letzteZeile - 2).Value = Sheets("PivotTable").Range( _
"A4:A" & letzteZeile).Value2
Sheets("02_b02_articleunit").Range("B2:B" & letzteZeile - 2).Value = Sheets("PivotTable").Range( _
"G4:G" & letzteZeile).Value2
Sheets("02_b02_articleunit").Range("C2:C" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("D2:D" & letzteZeile - 2).Value = Sheets("PivotTable").Range( _
"G4:G" & letzteZeile).Value2
Sheets("02_b02_articleunit").Range("E2:E" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("F2:F" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("G2:G" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("H2:H" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("I2:I" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("J2:J" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("K2:K" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("L2:L" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("M2:M" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("N2:N" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("O2:O" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("P2:P" & letzteZeile - 2).Value = "1"
Sheets("02_b02_articleunit").Range("Q2:Q" & letzteZeile - 2).Value = "1"
'Spalten an Inhalt anpassen
Cells.EntireColumn.AutoFit
Exit Sub
fehler1:
Worksheets("Übersicht").Range("D19").Value = "Das Feld Abgleich_ME_ME2 besitzt den Filter 1 _
nicht!"
End Sub
Sub b02_articleunit0()
On Error GoTo fehler0:
Dim pf As PivotField
Set pf = Sheets("PivotTable").PivotTables("PivotTable1").PivotFields("Abgleich_ME1_ME2")
'Remove existing filter
pf.ClearAllFilters
pf.CurrentPage = "0"
'Finde letzte Zeile
With Sheets("PivotTable")
zeilen_pivot = .Range("A" & .Rows.Count).End(xlUp).Row - 2
End With
With Sheets("02_b02_articleunit")
zeilen_articleunit1 = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
Sheets("02_b02_articleunit").Range("A" & zeilen_articleunit1 & ":A" & zeilen_articleunit1 * 2). _
Value = Sheets("PivotTable").Range("A4:A" & zeilen_pivot + 2).Value2
Sheets("02_b02_articleunit").Range("B" & zeilen_articleunit1 & ":B" & zeilen_articleunit1 * 2). _
Value = Sheets("PivotTable").Range("G4:G" & zeilen_pivot + 2).Value2
Sheets("02_b02_articleunit").Range("C" & zeilen_articleunit1 & ":C" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("D" & zeilen_articleunit1 & ":D" & zeilen_articleunit1 * 2). _
Value = Sheets("PivotTable").Range("G4:G" & zeilen_pivot + 2).Value2
Sheets("02_b02_articleunit").Range("E" & zeilen_articleunit1 & ":E" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("F" & zeilen_articleunit1 & ":F" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("G" & zeilen_articleunit1 & ":G" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("H" & zeilen_articleunit1 & ":H" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("I" & zeilen_articleunit1 & ":I" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("J" & zeilen_articleunit1 & ":J" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("K" & zeilen_articleunit1 & ":K" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("L" & zeilen_articleunit1 & ":L" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("M" & zeilen_articleunit1 & ":M" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("N" & zeilen_articleunit1 & ":N" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("O" & zeilen_articleunit1 & ":O" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("P" & zeilen_articleunit1 & ":P" & zeilen_articleunit1 * 2). _
Value = "1"
Sheets("02_b02_articleunit").Range("Q" & zeilen_articleunit1 & ":Q" & zeilen_articleunit1 * 2). _
Value = "1"
zeilen_articleunit2 = Worksheets("02_b02_articleunit").UsedRange.SpecialCells( _
xlCellTypeLastCell).Row + 1
zeilen_pivot2 = Worksheets("PivotTable").UsedRange.SpecialCells(xlCellTypeLastCell).Row * 3
Sheets("02_b02_articleunit").Range("A" & zeilen_articleunit2 & ":A" & zeilen_pivot2).Value = _
Sheets("PivotTable").Range("A4:A" & zeilen_pivot + 2).Value2
Sheets("02_b02_articleunit").Range("B" & zeilen_articleunit2 & ":B" & zeilen_pivot2).Value = _
Sheets("PivotTable").Range("F4:F" & zeilen_pivot + 2).Value2
Sheets("02_b02_articleunit").Range("C" & zeilen_articleunit2 & ":C" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("D" & zeilen_articleunit2 & ":D" & zeilen_pivot2).Value = _
Sheets("PivotTable").Range("D4:D" & zeilen_pivot + 2).Value2
Sheets("02_b02_articleunit").Range("E" & zeilen_articleunit2 & ":E" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("F" & zeilen_articleunit2 & ":F" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("G" & zeilen_articleunit2 & ":G" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("H" & zeilen_articleunit2 & ":H" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("I" & zeilen_articleunit2 & ":I" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("J" & zeilen_articleunit2 & ":J" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("K" & zeilen_articleunit2 & ":K" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("L" & zeilen_articleunit2 & ":L" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("M" & zeilen_articleunit2 & ":M" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("N" & zeilen_articleunit2 & ":N" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("O" & zeilen_articleunit2 & ":O" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("P" & zeilen_articleunit2 & ":P" & zeilen_pivot2).Value = "0" _
Sheets("02_b02_articleunit").Range("Q" & zeilen_articleunit2 & ":Q" & zeilen_pivot2).Value = "0" _
'NV Zeilen löschen
Call NV_löschen
Exit Sub
fehler0:
Worksheets("Übersicht").Range("D19").Value = "Das Feld Abgleich_ME_ME2 besitzt den Filter 0 _
nicht!"
End Sub