ich habe bei deiner letzten Nachricht nicht alles verstanden, vor allem wundert mich die Fehlermeldung mit F8 und F6. Bei meinem PC gibt es nıur die Tast F5 um ein Makro im Modul direkt zu starten. Vielleicht sind die Funktionen zwischen unseren PCs unterschiedlich?? I dont now??
Im Augenblick treffe ich Urlaubs Vorbereitungen, werde auch im Forum ca. einen Monat Pause machen, muss noch viel erledigen. Um dir weiter zu helfen habe eine neue Beispieldatei mit Verbesserungen angehangen. Alle neuen Befehle sind mit "**" markiert, damit du schneller erkennen kannst was ich geandert habe. Wenn du den Code schon selbst geaendert hast kopiere dir nur die neuen Aenderungen in deinen Code. Ich erklaere es dir.
Im neuen Beispiel gibt es eine Zelle nur für die Datei Endung zu aendern. Auf "xlsx" kannst du verzichten, das wird wenn es fehlt automatisch hinten angehangen. Du siehst auch die neue Zelle "Last Name". Da steht der letzte Speichername drin. Vor dem Öffnen vergleiche ich nun den Old Name mit der neuen Datei Endung. Wurde die nicht geaendert startet das Makro nicht, bricht mit Fehlermeldung ab. Ich denke das ist sinnvoll.
Zur Datei Ednung sage ich, warum haengst du nicht den Monat oder die Kalender-Woche wo du speicherst hinten dran statt "neu". Dann weisst du sofort was in der Datei gespeichert ist, und kannst sie alle im gleichen Ordner speichern. Vor dem Speichern findest eine neue "On Error" Anweisung, nur für Close Fehler. Wie findest du die neuen Ideen??
22.01.2018, 23:09 (Dieser Beitrag wurde zuletzt bearbeitet: 22.01.2018, 23:09 von Alooha.)
Hallo,
ich habe mich zweideutig ausgedrückt: mit F8 meinte ich die Taste, aber mit F5 und F6 die jeweilige Zelle.
Vielen dank für den neuen Code.
Allerdings habe ich Probleme, mich in dem "Switch" zurechtzufinden: es gibt jetzt 3 mal die Destination.
Zitat:Du siehst auch die neue Zelle "Last Name". Da steht der letzte Speichername drin. Vor dem Öffnen vergleiche ich nun den Old Name mit der neuen Datei Endung. Wurde die nicht geaendert startet das Makro nicht, bricht mit Fehlermeldung ab. Ich denke das ist sinnvoll.
Das verstehe ich nicht. Der alte Name ist ja der Sourcename! Einen anderen gibt es nicht vor dem Kopiervorgang und dem Abspeichern.
Wenn ich das begriffen habe werde ich den neuen Code ausprobieren.
Eigentlich funktioniert der "alte" Code ja auch, und ich habe mir, wie gesagt, eine Methode mit Listen (Dienststellen und Monat) zusammengebastelt, um die Auswahlen zu treffen, und das funktioniert ganz gut.
Ich hatte vergessen, dass in der destination Datei der Monat in Zahlenform in die Zelle BA3 eingegeben werden muß. Ich habe mit SVERWEIS() die Monatsnummer aus dem Namen "gezaubert", und in dem "Switch" abgelegt, sodass ich eine einfache = Formel aufgezeichnet habe. Das ist allerdings nicht so elegant gelöst wie du das machen würdest, mit einer Variablen, aber da die destination Datei immer die selbe ist fuinktioniert das; da steht halt der Name des WB's anstatt einer Variablen.
"new" hinten anzuhängen ist ok, damit komme ich gut klar.
Einen schönen Urlaub wünsche ich dir!
Vale!
Alooha
schau einfach genau hin was das Programm macht, dann verstehst du den Sinn.
Zitat:Du siehst auch die neue Zelle "Last Name".
Wenn du das Makro laufen laesst und die Datei wurde gespeichert, dann merkt mein Code sich diesen Namen in der Zelle "Last Name". Was ja korrekt ist, es ist ja der zuletzt gespeicherte Name.
Willst du das Programm neu starten und hast vergessen einen neuen Dateinamen zu vergeben, eine neue Endung in die Zelle zu schreiben, dann erkennt mein Progrmm den Fehler und verweigert die Dateien zu Öffnen, weil er sie unter dem "alten Namen"
Sorry, falsche Taste gedrückt, gesendet bevor ich fertig war.
weil er sie unter dem "alten Namen" kein zweitesmal speichern kann. Das führt ja zu Laufzeitfehler. Also erinnert dich das Makro daran bitte zuerst eine neue Endung einzugeben, bevor das Programm normal starten kann. Das ist alles.
vielen Dank!
Wenn man eine komplizierte Sache vereinfacht darstellen oder besser nachbilden will, danns vergisst man leicht etwas.
Was mir passiert ist. Ich hatte total vergessen, dass Daten aus einem dritten WB gebraucht werden, und die richtigen Daten sind nur zur Verfügung, wenn in einer Zelle in einem bestimmten Blatt der gleiche Text steht wie der der Anfang des Namens des Source und des Destination-WB.
Eigentlich ist das ganze auch einfacher möglich: Ich hatte auch vergessen, dass ich schon einen Code habe, mit dem ich das Destination WB erstellen kann, mitsamt allen Blättern.
Sodass ich lediglich ein Stück Code brauche das von jedem Blatt des SourceWB's in das entsprechende Destinationsheet kopiert.
Ich weiss nicht, trotz angestrengtem Studierens deines Code's, der ja zum Schluss genau das macht (nachdem er alle Blätter erstellt hat), wie ich Excel beibringen kann, vom Blatt Namex die Daten in das gleichnamige Blatt zu kopieren.
ich habe den alten Code auf die schnelle umgeschrieben -ohne- Worksheet.Add, indem nur geprüft wird ob die Blaetter in Source und Destination namentlich übereinstimmen. Bei Fehlen bricht das Programm ab. Ansonsten ist der Kopiervorgang genau gleich wie im alten Makro. Jetzt muss ich Schluss machen, habe privat zu tun.
mfg Gast 123
Code:
Option Explicit '24.1.2017 Gast 123 Clever Forum
Dim Blatt As String, Txt As String
Dim Old As String, Neu As String
Sub Daten_vonAlt_inNeu_kopieren_2()
Dim NewDatei As String, i, k, f
Dim Pfad As String, Datei As String
Dim DestSht As Integer, SrcSht As Integer
Dim DestWb As Workbook, SrcWb As Workbook
'** Vorprüfung auf Speichern Fehler, alter Dateiname!!
NewDatei = ThisWorkbook.Sheets(1).Range("D2").Value
Old = ThisWorkbook.Sheets(1).Range("D3").Value
Neu = ThisWorkbook.Sheets(1).Range("E2").Value
If Right(Neu, 4) <> "xlsx" Then Neu = Neu & ".xlsx"
NewDatei = NewDatei & " " & Neu 'neuer Dateiname
If NewDatei = Old Then
MsgBox "Datei Endung wurde nicht umbenannt - kann neue Datei NICHT Speichern!!": Exit Sub
End If
'** bis hier komplett neu eingefügt !!
'Alle Dateien die sich in "ToBeCopied" befinden, eine nach der anderen öffnen
On Error GoTo Fehler
'Source Öffnen, danach Destination öffnen
Pfad = ThisWorkbook.Sheets(1).Range("J1").Value
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
Datei = ThisWorkbook.Sheets(1).Range("J2").Value
Workbooks.Open Filename:=CStr(Pfad & Datei)
'Das WB "Destination" öffnen, vom Modellblatt soviele Kopien machen wie es Blätter in der Quelldatei gibt
'(ausser 3 Blätter: NichtKopieren 1 bis 3), in "Destination),
ThisWorkbook.Activate
'Set Varişable über Datei aus Zellen bilden
Datei = ThisWorkbook.Sheets(1).Range("J2").Value
Set SrcWb = Workbooks(Datei)
Datei = ThisWorkbook.Sheets(1).Range("J3").Value
Set DestWb = Workbooks(Datei)
'Schleife für alle Source Tabellen prüfen (ausser 1-3!!)
For k = 1 To SrcSht
'Prüfen ob alle Tabellen vorhanden sind
Blatt = SrcWb.Worksheets(k).Name: Txt = ""
'Blatt Résumé, Tableau, Codes nicht kopieren!!
If Blatt = "Résumé" Or Blatt = "Tableau" Or Blatt = "Codes" Then
Else 'alle anderen Blaetter Prüfen
For i = 1 To DestWb.Worksheets.Count
If DestWb.Worksheets(i).Name = Blatt Then Txt = "Ja": Exit For
Next i
'fehlende Blaetter direkt erstellen
If Txt = "" Then f = f + 1: MsgBox Blatt & " fehlt in Destination"
Next k
'Abbruch wenn Blätter zum kopieren fehlen!!
If f > 0 Then MsgBox f & " Abbruch wegen fehlenden Blättern": Exit Sub
'Schleife für alle Source Tabellen prüfen (ausser 1-3!!)
For k = 1 To SrcSht
Blatt = SrcWb.Worksheets(k).Name
If Blatt = "Résumé" Or Blatt = "Tableau" Or Blatt = "Codes" Then
Else 'alle anderen Blaetter Prüfen
SrcWb.Worksheets(k).Range("A6:A66").Copy _
DestWb.Worksheets(Blatt).Range("A6:A66")
SrcWb.Worksheets(k).Range("U1").Copy _
DestWb.Worksheets(Blatt).Range("U1")
End If
Next k
'Dann die selbe Operation mit den anderen Blättern
'und unter dem selben Namen abspeichern wie die Quelldatei & "new"
'** On Error neu eingefügt, nur für Close
On Error GoTo closeErr
Pfad = ThisWorkbook.Sheets(1).Range("D1").Value
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
