Kopieren ausgewählter sheets in neue Map

Hallo liebes Forum,
ich bitte um Eure Hife, da ich mit einem Projekt nicht weiterkommen.
Die Mappe besteht aus mehreren Sheets, wobei jedes Sheet ein Angebotsblatt für ein Produkt sein soll.
Nun ist der Plan auf der Ersten Seite z.B. via Dropdown eine Auswahl zu treffen, welche Angebotsblätter für die aktuelle Anfrage benötigt werden.
Mein Ansatz ist, irgendwie die benötigten Sheet-Namen in Tabelle 1 z.B. A1 zu bringen --> A1 = "Produkt1", "Produkt2", "Produkt4"
und diese Zelle A1 in folgenden Code einzubinden.
Frage Nr1. ist mein Ansatz ok ? Oder wäre da eine andere Herangehensweise besser geeignet.
Frage Nr2 wie schaffe ich es, dass im das Produktblatt von z.B. Produkt 4 zweimal in die neue Arbeitsmappe bringe ?
Frage Nr3 was mache ich mit dem "Merker" falsch, der aus der Zelle A1 die benötigten "Blätter" (als Text : "Produkt1", "Produkt2", "Produkt4" ) in die Formel bringen soll ?
Lieben Dank und allen einen guten Wochenstart !!!


Sub Kopieren()
Dim wks As Worksheet
Dim produkte As String
produkte = Sheets("Tabelle1").Range("A1").Value
Sheets(Array(produkte)).Copy
For Each wks In ActiveWorkbook.Worksheets
Next
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Michael!
Das Auswahlfeld zu bestücken geht so:


Sub sheets_sammlung()
For i = 2 To Sheets.Count
sheetsammlung = sheetsammlung & Sheets(i).Name & ","
Next i
With Range("A1").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=sheetsammlung
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub

aber das hilft dir noch nicht so richtig weiter.
Wenn ich es richtig verstehe, willst du das Sheet als Vorlage verwenden und bei der Auswahl die Kopie des Sheets bearbeiten.
Dann brauchst du noch einen Code, den du in das erste Tabellenblatt reinschreibst. Der reagiert nur bei Auswahl der Zellenwerte.


Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("A1") And Target  "" Then
Sheets(Target.Text).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Application.InputBox("neuer Name", "neuer Name", "Tach, Ich bin der Neue")
End If
End Sub

Probier es mal aus
Gruß, MCO

Sub Kopieren() Dim wks As Worksheet Dim new_wb As Workbook Dim Bereich As Variant Dim z As Long, bl As Long Set Beginn = Range("C6") Set Ende = Beginn.End(xlDown).Offset(0, 1) Bereich = Range(Beginn, Ende) Set new_wb = Application.Workbooks().Add For bl = 1 To UBound(Bereich) For z = 1 To Bereich(bl, 2) ThisWorkbook.Sheets(Bereich(bl, 1)).Copy , new_wb.Sheets(Sheets.Count) Next z Next bl Application.DisplayAlerts = False new_wb.Sheets(1).Delete Application.DisplayAlerts = True Application.Dialogs(xlDialogSaveAs).Show End Sub

Beliebteste Forumthreads (12 Monate)

Kopieren ausgewählter sheets in neue Map

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kopieren ausgewählter sheets in neue Map

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread