Moinsen,

also Tabellenblatt1 ist die Eingabetabelle, hier werden Daten eingegeben. Mit einem Makro werden diese Daten dann aufbereitet in einer Tabelle für das Erstellen von Serienbriefen (dabei werden mehrfachnennungen  ausgesiebt) --> Tabelleblatt 3, eine zweite Liste zum Versandt --> Tabellenblatt 4, am Schluss wird die Datei dann mit Datum und Co. gespeichert. anbei mal der VBA Text.

Nun möchte ich vor dem Speichern, das im Tabellenblatt1 (Eingabeliste) die Zeilen (in der Spalte A) nummeriert werden, wenn Spalte D ausgefüllt ist.

Ich hoffe das es jetzt verständlicher ist.

LG

Chris

Public MYPATH As String
Option Explicit


Sub Start()

'Kopieren der Daten für die umschläge
    'Namen
    Worksheets("Auswahllisten").Range("F2:F105").Copy
    Worksheets("Daten Umschläge").Range("A2").PasteSpecial xlPasteValues
    'Adresse
    Worksheets("Eingabetabelle").Range("H3:H105").Copy
    Worksheets("Daten Umschläge").Range("B2").PasteSpecial xlPasteValues
    'PLZ Ort
    Worksheets("Eingabetabelle").Range("I3:I105").Copy
    Worksheets("Daten Umschläge").Range("C2").PasteSpecial xlPasteValues
'Kopieren der Daten für LLBB
    'WUS
    Worksheets("Eingabetabelle").Range("D3:D105").Copy
    Worksheets("Daten LLBB").Range("A2").PasteSpecial xlPasteValues
    'Anzahl Proben
    Worksheets("Eingabetabelle").Range("E3:E105").Copy
    Worksheets("Daten LLBB").Range("B2").PasteSpecial xlPasteValues
    'Name TA
    Worksheets("Eingabetabelle").Range("F3:F105").Copy
    Worksheets("Daten LLBB").Range("C2").PasteSpecial xlPasteValues
    'Name Jäger
    Worksheets("Eingabetabelle").Range("G3:G105").Copy
    Worksheets("Daten LLBB").Range("D2").PasteSpecial xlPasteValues
    'Telefon
    Worksheets("Eingabetabelle").Range("J3:J105").Copy
    Worksheets("Daten LLBB").Range("E2").PasteSpecial xlPasteValues
    'Anmerkung
    Worksheets("Eingabetabelle").Range("L3:L105").Copy
    Worksheets("Daten LLBB").Range("F2").PasteSpecial xlPasteValues
'Duplikate entfernen
    Worksheets("Daten Umschläge").Range("$A$1:$C$105").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
'Numnmerierung einfügen
    Range("a3:a105").FormulaLocal = "=WENN(NICHT(ISTLEER(B3));ANZAHL2($B$3:B3);"")"
   
'Datei Speichern und beenden
    'Worksheets("Eingabetabelle").SaveCopyAs "DATEIPFAD_" & Format(Now, "dd.mm.yyyy") & ".xlsm"
    'ThisWorkbook.Saved = True
    'Application.Quit
Call MacroMitDeinemFormularSteuerelementVerknuepfen


End Sub

'Option Explicit
  

  
Sub MacroMitDeinemFormularSteuerelementVerknuepfen()
    Dim sText As String
        
    MYPATH = Environ("temp")
     
    sText = "Sehr geehrte Damen und Herren,<br><br>"
    sText = sText & "anbei die Daten der heutigen XXX."
    sText = sText & ""
    
    Call SendSheetOutlook( _
                            "XXX", _
                            "XXX", _
                            "", _
                            sText)
End Sub
  
Private Sub SendSheetOutlook(sSubject As String, sTo As String, sCC As String, ByVal sText As String)
Dim olApp         As Object
Dim AWS           As String
Dim olOldBody     As String
    
'define temporary Path and Filename
AWS = MYPATH & "\" & Format(Date, "YYYYMMDD") & "_" & Format(Time, "hhmmss") & "_" & _
WorksheetFunction.Substitute(ActiveWorkbook.Name, ".xlsm", "")
    
'export File as PDF
AWS = AWS   'debug-stop

Worksheets("Daten LLBB").ExportAsFixedFormat Type:=xlTypePDF, Filename:=AWS, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
AWS = AWS & ".pdf"
    
'Make Email
Set olApp = CreateObject("Outlook.Application")
   With olApp.CreateItem(0)
             .GetInspector.Display
             olOldBody = .htmlBody
             .To = sTo
             .cc = sCC
             .Subject = sSubject
             .htmlBody = sText & olOldBody
            .Attachments.Add AWS
   End With
       
AWS = AWS   'debug-stop
'remove TEMP file
'********************************
'wenn du das PDF behalten möchtest, diese Zeile auskommentieren!
'sonst wird das temporäre PDF wieder gelöscht
'Kill AWS
'********************************
'Datei Speichern und beenden
    ActiveWorkbook.SaveCopyAs "DATEIPFAD" & Format(Now, "dd.mm.yyyy") & ".xlsm"
    ThisWorkbook.Saved = True
    Application.Quit
    
End Sub


'Gleiche Fehlermeldung wieder.