Sheets kopieren wenn Zelle Namen enthält
07.04.2020 11:38:03
Edgar
ich bin gerade dabei einen Code zu schreiben, der folgende Aufgaben ausführen sollte:
In meiner Excel Datei (bestehend aus ca. 80 Sheets) soll jedes Sheet nacheinander durchgegangen werden. Wenn im Feld D18 ein bestimmter Name auftaucht, sollen die jeweiligen Sheets kopiert und in eine neue Datei eingefügt werden (ursprüngliche Formatierung sollte wenn möglich beibehalten werden) und diese im Anschluss abspeichern. Dabei ist zu beachten, dass dieser Name etwa 1-10 Mal innerhalb der 80 Sheets auftauchen wird.
Dies sollte für etwa 20 Namen ausgeführt werden. Die Namen befinden sich alle im letzten Sheet ("Definitionen") in den Feldern A85:A105.
Leider sind meine VBA Kenntnisse noch kaum vorhanden, da ich damit erstmals in der vergangenen Woche angefangen habe. Hier aber mein bisheriger Code (Dieser bezieht sich leider noch nicht auf die Felder A85:A105, da ich davor schon auf Probleme gestoßen bin.)
Sub TestMustermannSheets()
Worksheets(1).Activate
Dim intAnzahlSheets As Integer
For intAnzahlSheets = 1 To (ActiveWorkbook.Worksheets.Count - 1)
If Range("D18").Value Like "*Max Mustermann*" Then
ActiveSheet.Copy
Else
ActiveSheet.Next.Activate
End If
Next
ActiveWorkbook.SaveAs Filename:= _
"\\Speicherpfad\2020_Max_Mustermann.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
Ich hoffe, dass es nicht zu umständlich ist und ihr mir hierbei helfen könnt.
Vielen lieben Dank!
Gruß Edgar
Anzeige