Makro

[Martin und Kamilla]

Ja Ihr habt recht die Datei wird zu groß.
Wenn ich jeden Kunden separat in einen Ordner speicher, kann ich Ihn dann in meinem Tabellenblatt "Übersicht" der reihe nach auflisten und mit einem Hyperlink versehen um Ihn später wieder zu öffnen?


Gruß
Martin

[Käpt'n Blaubär]

Hallo,

Wenn ich jeden Kunden separat in einen Ordner speicher, kann ich Ihn dann in meinem Tabellenblatt "Übersicht"
der reihe nach auflisten und mit einem Hyperlink versehen um Ihn später wieder zu öffnen?

Rückfrage: Haben bei Dir die Kunden keine eigene und eindeutige Kundennummer?
Das wäre dann das Nächste, was ich dringend ändern würde.

Man könnte dann hergehen, die Kunden jeweils unter der Kundennummer zu speichern.
Setzt man dann noch das jeweils aktuelle Datum mit in den Dateinamen und speichert die
Datei unter Datum_Kundennummer, dann kann man mühelos den ganzen Kram in nur
einem einzigen Ordner ablegen und erhält sogar noch eine chronologische Ordnung der 
Kundendaten gratis dazu.

Was die Geschichte mit dem Hyperlink angeht, ... man könnte das auch mit einer Maske
oder einem Userform erreichen. Nur mal so, als Erweiterung der denkbaren Möglichkeiten.

[Martin und Kamilla]

Hallo nochmal,

wenn es diese Möglichkeit gibt, dann sollte es wie folgt aussehen.

Tabellenblatt mit dem Namen aus C4 benennen
Tabellenblatt in eine neue Datei verschieben 
Tabellenblatt unter dem Namen aus C4 im Ordner "Kelterscheine" auf dem Desktop abspeichern
Datum, Name, Hyperlink, im Tabellenblatt "Übersicht" der Reihe nach erstellen"
Datei schließen

[Crazy Tom]

Hallo Martin

du hast in deiner Datei etliche Formeln die dann auf die Hauptdatei verlinken
so zum Beispiel in der Spalte mit den Preisen
wenn du dann im Nachhinein die Dateien öffnest wird Excel
dich jedes mal fragen ob die Formeln aktualisiert werden sollen
irgendwann werden sich deine Preise ändern und schon wird es dir deine
alten Dateien durcheinander bringen
also wenn schon, dann die Hauptdatei und nicht nur 1 Blatt als Kopie speichern
den Speichervorgang kannst du bequem mit dem Makrorekorder aufnehmen
dann hast du dafür schon mal ein Grundgerüst
zusätzlich würde es dann Sinn machen, eine Übersichtsdatei zu erstellen in der
tatsächlich nur die einzelnen Dateien aufgeführt sind und per Hyperlink,
auf welche Weise auch immer, diese Dateien geöffnet werden

MfG Tom

[Martin und Kamilla]

Ja so werde ich das machen.

Gruß
Martin

[Crazy Tom]

Hallo Martin

ich hab da mal was vorbereitet

Code:

Sub prcKopie()
   Dim strName As String
   Dim lngZiel As Long
'   hier wird die Übersichtstabelle geöffnet _
   die heißt bei mir Uebersicht und befindet sich _
   auf MEINEM Desktop _
   also Name von Desktop und Datei anpassen
   Workbooks.Open Filename:="C:\Users\Tom\Desktop\Uebersicht.xlsm"
   With Workbooks("Uebersicht").Sheets("Übersicht")
       lngZiel = .Cells(Rows.Count, 1).End(xlUp).Row + 1
       If lngZiel <= 2 Then lngZiel = 3
       .Cells(lngZiel, 1).Value = Date
       .Cells(lngZiel, 2).Value = ThisWorkbook.Sheets("1").Range("w3")
       .Cells(lngZiel, 3).Value = ThisWorkbook.Sheets("1").Range("c4")
       strName = Format(ThisWorkbook.Sheets("1").Range("W3"), "dd.mm.yyyy") & _
                   "-" & ThisWorkbook.Sheets("1").Range("C4") & ".xlsm"
   ChDir "C:\Users\Tom\Desktop\Kelterscheine"
   ThisWorkbook.SaveCopyAs Filename:= _
       "C:\Users\Tom\Desktop\Kelterscheine\" & strName
       .Hyperlinks.Add Anchor:=.Cells(lngZiel, 4), Address:= _
       "Kelterscheine\" & strName, TextToDisplay:=strName
       Workbooks("Uebersicht").Close True
   End With
End Sub

dieser Code gehört in deine ursprüngliche Datei
dort füllst du dann das Blatt "1" aus
vorher solltest du dir eine Übersichtsdatei "Uebersicht" auf dem Desktop anlegen
wenn du dann das Blatt "1" ausgefüllt hast, den Code starten
die Datei wird als Kopie unter dem Namen in Zelle C4 und dem Datum in W3
im Ordner Kelterschein, auf dem Desktop (beachte den Namen Tom im Pfad) gespeichert
zwischendurch wird die Datei "Uebersicht" auf dem Desktop geöffnet
und die relevanten Daten & Hyperlink eingetragen
deine Ursprungsdatei wird NICHT geändert sondern
nur eine Kopie abgespeichert

MfG Tom

[Martin und Kamilla]

Hallo Tom,

der Code läuft. Nur leider speichert der in der Übersicht jeden weiteren Kunden in die selbe erste Zeile und überschreibt die den vorherigen somit.
In der Tabelle Uebersicht auf dem Desktop wird der Kunde mit dem Hyperlink nicht abgelegt. Ist das richtig?

Gruß
Martin

[Crazy Tom]

Hallo Martin

in meinem Test wird jeder neue Eintrag eine Zeile tiefer eingetragen
der Code richtet sich dabei nach den Einträgen in Spalte A
wird da bei dir auch etwas eingetragen?
in meinem Test wird in Spalte D der Hyperlink zur Datei im Ordner
Kelterscheine auf dem Desktop geschrieben
zeig mal deinen Code, vielleicht stimmt da etwas nicht
was für eine Excel-Version hast du?
xl2014? ist das für Mac?

MfG Tom

[Martin und Kamilla]

Hallo Tom,

habe die 2013 Excel Version auf meinem Windows PC.

Mein Code:


Sub prcKopie()
    Dim strName As String
    Dim lngZiel As Long
'   hier wird die Übersichtstabelle geöffnet _
    die heißt bei mir Uebersicht und befindet sich _
    auf MEINEM Desktop _
    also Name von Desktop und Datei anpassen
    Workbooks.Open Filename:="C:\Users\Martin Wietz\Desktop\Uebersicht.xlsm"
    With Workbooks("Uebersicht").Sheets("Übersicht")
        lngZiel = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        If lngZiel <= 2 Then lngZiel = 3
        .Cells(lngZiel, 1).Value = Date
        .Cells(lngZiel, 2).Value = ThisWorkbook.Sheets("1").Range("w3")
        .Cells(lngZiel, 3).Value = ThisWorkbook.Sheets("1").Range("c4")
        strName = Format(ThisWorkbook.Sheets("1").Range("W3"), "dd.mm.yyyy") & _
                    "-" & ThisWorkbook.Sheets("1").Range("C4") & ".xlsm"
    ChDir "C:\Users\Martin Wietz\Desktop\Kelterscheine"
    ThisWorkbook.SaveCopyAs Filename:= _
        "C:\Users\Martin Wietz\Desktop\Kelterscheine\" & strName
        .Hyperlinks.Add Anchor:=.Cells(lngZiel, 4), Address:= _
        "Kelterscheine\" & strName, TextToDisplay:=strName
        Workbooks("Uebersicht").Close True
    End With
End Sub

Gruß
Martin

[Crazy Tom]

Hallo Martin

lass mal probeweise diesen Code
aus deiner Hauptdatei laufen
da sollte in der MsgBox die erste freie Zeile in Spalte A angezeigt werden

Code:

Sub prcKopietest()
   Dim strName As String
   Dim lngZiel As Long
'   hier wird die Übersichtstabelle geöffnet _
   die heißt bei mir Uebersicht und befindet sich _
   auf MEINEM Desktop _
   also Name von Desktop und Datei anpassen
   Workbooks.Open Filename:="C:\Users\Martin Wietz\Desktop\Uebersicht.xlsm"
   With Workbooks("Uebersicht").Sheets("Übersicht")
       lngZiel = .Cells(Rows.Count, 1).End(xlUp).Row + 1
       If lngZiel <= 2 Then lngZiel = 3
       MsgBox lngZiel
'        .Cells(lngZiel, 1).Value = Date
'        .Cells(lngZiel, 2).Value = ThisWorkbook.Sheets("1").Range("w3")
'        .Cells(lngZiel, 3).Value = ThisWorkbook.Sheets("1").Range("c4")
'        strName = Format(ThisWorkbook.Sheets("1").Range("W3"), "dd.mm.yyyy") & _
'                    "-" & ThisWorkbook.Sheets("1").Range("C4") & ".xlsm"
'    ChDir "C:\Users\Martin Wietz\Desktop\Kelterscheine"
'    ThisWorkbook.SaveCopyAs Filename:= _
'        "C:\Users\Martin Wietz\Desktop\Kelterscheine\" & strName
'        .Hyperlinks.Add Anchor:=.Cells(lngZiel, 4), Address:= _
'        "Kelterscheine\" & strName, TextToDisplay:=strName
       Workbooks("Uebersicht").Close False
   End With
End Sub

während die MsgBox noch offen ist kannst du die Tabelle noch sehen

MfG Tom