Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1748to1752
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Sheets kopieren wenn Zelle Namen enthält

Sheets kopieren wenn Zelle Namen enthält
07.04.2020 11:38:03
Edgar
Hallo zusammen
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sheets kopieren wenn Zelle Namen enthält
08.04.2020 15:05:10
ChrisL
Hi Edgar
Sub Makro1()
Dim WB As Workbook
Dim WS As Worksheet
Application.ScreenUpdating = False
For Each WS In ThisWorkbook.Worksheets
If WS.Range("D18") Like "*Max Mustermann*" Then
If WB Is Nothing Then
WS.Copy
Set WB = ActiveWorkbook
Else
WS.Copy After:=WB.Worksheets(WB.Worksheets.Count)
End If
End If
Next WS
WB.SaveAs Filename:="\\Speicherpfad\2020_Max_Mustermann.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
cu
Chris
Anzeige

314 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige