|
Hallo Nobody,
vielen Dank für Deine schnelle Rückmeldung. Ich habe versucht Dein Makro auf meine Umgebung anzupassen, es läuft auch durch. Leider kommt nicht das Ergebnis was ich erhofft hatte. Aktuell bekomme ich mit diesem Makro 2 Dateien.
1. Datei: Dateiname = Pers.-Nr. (Spalte G) => richtig / Inhalt leider nur 2 Zeilen (Überschrift und 1. Datenzeile) - insgesamt habe ich für diese Pers.-Nr. aber 642 Zeilen.
2., Datei: Dateiname = Inhalt aus Spalte A => leider nicht richtig / Inhalt alle Zeilen der Datei
Vielleicht habe ich auch irgendwo etwas zu viel verändert :-(
Kannst Du vielleicht noch einmal schauen?
Sub Personaldatei_erstellen()
Dim PersNr As Variant, a As Long
Dim AAdr As String, EAdr As String
Dim AA As Range, j As Long, lz1 As Long
'** Hier bitte den Namen deiner Personal Tabelle angeben!!
With ThisWorkbook.Worksheets("Tabelle1")
'LastZell in Personalliste suchen Spalte G
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
'1. Personal Nummer + Anfangs Adresse setzen
PersNr = .Range("G2").Value
AAdr = "a1" '1.Copy Adr.
Application.ScreenUpdating = False
On Error GoTo Fehler
'Schleife zum abarbeiten aller Personal Nummern
For j = 2 To lz1
If .Cells(j + 1, 1) <> PersNr Then
'** zu kopierende Spaltenbreite selbst festlegen
EAdr = .Cells(j, 45).Address '45 = Spalte AS
.Range(AAdr, EAdr).Copy 'Bereich A-AS kopieren
Workbooks.Add
ActiveSheet.Paste
'Neue Datei mit Pers. Nummer speichern
ActiveWorkbook.SaveAs Filename:="C:\Users\Pich\Desktop\Test\" & PersNr
ActiveWorkbook.Close savechanges:=False
'nächste Personal Nummer laden
PersNr = .Cells(j + 1, 1)
AAdr = .Cells(j + 1, 1).Address
End If
Next j
End With
Exit Sub
Fehler: MsgBox PersNr & " unerwarteter Fehler aufgetreten" & vbLf & Error()
End Sub
Haben wir sonst vielleicht die Möglichkeit, dass ich Dir die Datei irgendwie zur Verfügung stellen kann? Ich bin hier unerfahren.
Freue mich auf eine Rückmeldung.
Viele Grüße
Simone
|