Hallo Zusammen,
das Herber-Forum hat mir bis dato immer viele super Tipps und Hilfen gegeben. Allerdings ist mein aktuelles Problem so durchwachsen, dass ich hier etwas Hilfe benötige.
Ich möchte aus einer Datenmatrix:
1) Einen bestimmten Wert filtern
2) Eine neues Workbook erstellen und am Ende mit Wunschnamen und Ort speichern
3) für jeden Kunden ein Sheet erzeugen
4) 2 unterschiedliche Teile der Matrix, gefiltert, in jedes Kunden-Sheet einfügen
Ich bin bis zum Start vom Kopiervorgang gekommen:
Sub Kundenbefragung_Wertung()
'
' Erstellen des neuen Workbooks & Speichern
Dim wb As Workbook
Dim wsNew As Worksheet
Dim StName As String
MsgBox ("Neue Mappe erstellen?")
If MsgBox("Ja," & vbLf & "oder nein?", vbYesNo) = vbYes Then
StName = InputBox("Bitte gib den Dateinamen ein!")
Set wb = Workbooks.Add
End If
' Erstellen der einzelnen Sheets
Sheets("Tabelle1").Name = "Kunde1"
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde2"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde3"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde4"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde5"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde5"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde6"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde7"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde8"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde9"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde10"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde11"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde12"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde13"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde14"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde15"
.Move After:=Sheets(Sheets.Count)
End With
Set wsNew = Worksheets.Add
With wsNew
.Name = "Kunde16"
.Move After:=Sheets(Sheets.Count)
End With
' Kopiervorgang starten (hier verließ es mich dann)
Dim Daten1 As Range
Dim Daten2 As Range
Set Daten1 = Range("A5, I1000")
Set Daten2 = Range("J5, K1000")
Windows("aus der Anfangsdatei").Activate
ActiveSheet.Range("$A:$AP").AutoFilter Field:=11, Criteria1:=""
Daten1.Copy
Windows("StName.xlsx").Activate
Sheets("Danex").Select
Range("A2").PasteSpecial
....... weiter kam ich nicht und mir gehen die Ideen aus. Mir ist klar das ich das eleganter hätte schreiben können, aber dafür fehlt mir das Wissen und die Kreativität.
Über Hilfe freue ich mich. Vielleicht ist es schwer zu erfassen, was ich gerne machen wollen würde, mir reichen hier aber schon ein paar Ideen.
Danke und viele Grüße,
Andreas