Suchen, Finden, Kopieren, Einfügen mit VBA

[Aynor]

Hallo Leute,

ich möchte die von einem Kunden bestellten Erzeugnisse den dazugehörigen Einzelkomponenten zuordnen. Und zwar mittels Makro.
Unterm Strich kriege ich das auch hin, nur leider arbeite ich dabei mit dem Aufzeichnungstool und Pivottabellen und komme mir ziemlich plump vor.
Was mich jetzt brennend interessiert: Wisst ihr einen eleganteren Weg, um diese Aufgabe mittels VBA zu meistern?
Die Datei liegt anbei. Meine Makros habe ich aber sicherheitshalber mal entfernt. :s

Danke im Voraus!  

[Käpt'n Blaubär]

Hallo,

Daß Du eine Datei ohne Makros geliefert hast, ist völlig ok, da Du sonst eine
nicht unerhebliche Menge Helfer ausschließen würdest die Bedenken haben,
eine Datei mit Makros downzuloaden.

Also mich würden Deine Makros schon interessieren da das die Arbeit wesentlich
verkürzen und auch ein besseres Verständnis dafür geben würde, was Dir denn
wirklich so vorschwebt ... das ist meine Meinung ... .

[WillWissen]

Hi,

Meine Makros habe ich aber sicherheitshalber mal entfernt.

das ist völlig OK. Du solltest uns aber den Makrotext zur Verfügung stellen. Bitte kopiere ihn und stelle ihn hier ein. Benutze dazu bitte den 5. Schalter von rechts in der 2. Iconreihe.

[
Bild bitte so als Datei hochladen: Klick mich!
]

[schauan]

Halöchen,

noch ein Hinweis. Wenn Du eine Datei ohne Makros einstellst, dann bitte auch als xlsx. Wenn Du eine xlsm nimmst, dann werden diejenigen, die Bedenken gegen Makros haben, die Datei auch nicht downloaden.

Zu Deiner Anmerkung mit dem "eleganteren Weg" - wenn Du damit einen "eleganteren Code" meinst, möchte ich mich dahingehend den Vorrednern anschließen, dass zum Bewerten das Original nicht schlecht wäre. Aus dem Code kann man auch auf die Abläufe schließen, wenn einem die Erklärung nicht ganz reicht.

[Aynor]

Okay, hier habe ich den Code nochmal nachgebaut.
Besonders ärgerlich ist, dass ich die Pivot Tabelle in einem neuen Arbeitsblatt erstellen muss und nicht im vorhandenen Arbeitsblatt erstellen kann, (Zumindest weiß ich nicht wie), ohne dass es zu einem Makro-Abbruch kommt. Dadurch erhalte ich mit jedem erneuten Makro-Durchlauf ein neues fortlaufendes Arbeitsbaltt, das zwar nicht die Funktionsweise stört aber sehr unsauber aussieht.
Wenn Ihr noch weitere Infos benötigt, gerne Bescheid geben.

Code:

Sub ABestellteArtikelKopieren()
'
' BestellteArtikelKopieren Makro
'

'
   Columns("A:A").Select
   Selection.Copy
   Sheets("StrukturstuecklisteRohdatei").Select
   Range("A1").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Range("A1").Select
   Application.CutCopyMode = False
   Call BSVERWEISFilterwerteSchaffen
End Sub
Sub BSVERWEISFilterwerteSchaffen()
'
' SVERWEISPruefung Makro
'

'
   Range("D2").Select
   ActiveCell.FormulaR1C1 = _
       "=IF(ISNA(VLOOKUP(RC[-2],R2C1:R5C1,1,FALSE)),""Nicht Relevant"",VLOOKUP(RC[-2],R2C1:R5C1,1,FALSE))"
   Range("D2").Select
   Selection.AutoFill Destination:=Range("D2:D22")
   Range("D2:D22").Select
   Range("A1").Select
   Call CPivotErstellenUndKopieren
End Sub
Sub CPivotErstellenUndKopieren()
'
' Makro9 Makro
'

'
   Sheets("StrukturstuecklisteRohdatei").Select
   Columns("B:D").Select
       ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
       "StrukturstuecklisteRohdatei!R1C2:R1048576C4", Version:=xlPivotTableVersion15 _
       ).CreatePivotTable TableDestination:="", TableName:= _
       "PivotTable7", DefaultVersion:=xlPivotTableVersion15
   With ActiveSheet.PivotTables("PivotTable7").PivotFields("Filterwerte")
       .Orientation = xlPageField
       .Position = 1
   End With
   With ActiveSheet.PivotTables("PivotTable7").PivotFields("Erzeugnis")
       .Orientation = xlRowField
       .Position = 1
   End With
   With ActiveSheet.PivotTables("PivotTable7").PivotFields("Komponente")
       .Orientation = xlRowField
       .Position = 2
   End With
   ActiveSheet.PivotTables("PivotTable7").PivotFields("Filterwerte").CurrentPage _
       = "(All)"
   With ActiveSheet.PivotTables("PivotTable7").PivotFields("Filterwerte")
       .PivotItems("Nicht Relevant").Visible = False
       .PivotItems("(blank)").Visible = False
   End With
   ActiveSheet.PivotTables("PivotTable7").PivotFields("Filterwerte"). _
       EnableMultiplePageItems = True
   Columns("A:A").Select
   Selection.Copy
   Sheets("Ziel Sollstatus nach Makro").Select
   Range("A1").Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Range("A1").Select
End Sub

[schauan]

Hallöchen,

ich gehe jetzt Offline und schaue morgen Abend wieder rein :20:

[schauan]

Hallöchen,

AUfzeichnen ist für den Anfang schon nicht der schlechteste Weg, zumindest erst mal zu einem Grundgerüst zu kommen. Meist funktioniert das auch, manchmal gibt es das eine oder andere, was nicht geht.

Allgemein kann man z.B. schauen, wie man Select's, Scrollaktionen usw. wieder los wird. Das braucht oder macht man vielleicht bei der Aufzeichnung, aber der Code braucht es nicht wirklich.  

z.B. diese beiden Zeilen hier
Columns("A:A").Select
Selection.Copy
werden zu
Columns("A:A").Copy
Oder statt
Range("D2:D22").Select
Range("A1").Select
reicht
Range("A1").Select

Hier
With ActiveSheet.PivotTables("PivotTable7").PivotFields("Filterwerte")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable7").PivotFields("Erzeugnis")
.Orientation = xlRowField
.Position = 1
End With
...

könntest Du etwas sparen
With ActiveSheet.PivotTables("PivotTable7")
With .PivotFields("Filterwerte")
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields("Erzeugnis")
.Orientation = xlRowField
.Position = 1
End With
...
End With

Der Tabellenname in Deinem Code stimmt nicht mit dem Blattname in der Datei überein. Im Bereich B:D fehlen Daten in Spalte C. Für SourceData solltest Du nicht alle Zeilen des Blattes nehmen. Damit das flexibel wird, könntest Du die Daten als Tabelle zusammenfassen. Die passt sich automatisch an, wenn Du Daten hinzufügst und entsprechend wirkt sich das dann auch auf die Pivot aus.
Für die Positionierung auf dem Blatt nimmst Du z.B.
TableDestination:="'Strukturstückliste Rohdatei'!R1C6"

Ich gehe jetzt auch gleich wieder Offline und bin morgen für weitere Fragen bereit :-)

[Aynor]

Hallo und danke für deine Erklärung. Wirklich super!
Ich schaue es mir heute Abend genauer an und versuche meinen Code anzupassen.