Thema Datum  Von Nutzer Rating
Antwort
15.01.2021 08:59:46 Chris
Solved
15.01.2021 21:47:04 ralf_b
NotSolved
Rot Nummerierung wenn Zelle ausgefüllt
 20.01.2021 09:28:43 Gast55406
NotSolved
20.01.2021 10:01:37 Mase
NotSolved
20.01.2021 10:09:34 Chris
NotSolved
20.01.2021 10:42:11 Gast92613
NotSolved
20.01.2021 11:12:58 Chris
NotSolved
20.01.2021 12:29:27 Gast33902
NotSolved
20.01.2021 12:49:46 Chris
NotSolved
20.01.2021 14:04:17 Gast28058
NotSolved

Ansicht des Beitrags:
Von:
Gast55406		 Datum:
20.01.2021 09:28:43		 Views:
940		 Rating:
     
Antwort:
  Ja
Thema:
Nummerierung wenn Zelle ausgefüllt

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

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
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.

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
15.01.2021 08:59:46 Chris
Solved
15.01.2021 21:47:04 ralf_b
NotSolved
Rot Nummerierung wenn Zelle ausgefüllt
 20.01.2021 09:28:43 Gast55406
NotSolved
20.01.2021 10:01:37 Mase
NotSolved
20.01.2021 10:09:34 Chris
NotSolved
20.01.2021 10:42:11 Gast92613
NotSolved
20.01.2021 11:12:58 Chris
NotSolved
20.01.2021 12:29:27 Gast33902
NotSolved
20.01.2021 12:49:46 Chris
NotSolved
20.01.2021 14:04:17 Gast28058
NotSolved