Option Explicit
Sub tst()
Dim lngL As Long, ii As Long
With Sheets("Tabelle1")
lngL = .Cells(.Rows.Count, 4).End(xlUp).Row ' letzte in Sp.4 (D) belegte Zeile
For ii = 1 To lngL
' ... dein Code
Next ii
End With
End Sub
Sub ()
Dim olApp As Object
Dim wsShell
Dim iCounter As Long
If MsgBox("Soll der automatische E-Mail Versand gestartet werden?", _
vbYesNo + vbQuestion, "Frage") = vbNo Then Exit Sub
For iCounter = 1 To 2
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
Sheets("Selektionsliste").Select
.To = Cells(iCounter, 1)
.Subject = Cells(iCounter, 12)
.Body = Cells(iCounter, 14) & vbCrLf & vbCrLf & _
Cells(iCounter, 15) & vbCrLf & _
Cells(iCounter, 16) & vbCrLf & vbCrLf & _
Cells(iCounter, 17) & vbCrLf & vbCrLf & _
Cells(iCounter, 18) & vbCrLf
.Display
Set wsShell = CreateObject("WScript.Shell")
wsShell.AppActivate olApp
wsShell.SendKeys "%s"
Set wsShell = Nothing
Application.Wait (Now + TimeValue("0:00:05"))
End With
Next iCounter
Set olApp = Nothing
MsgBox "Der E-Mail Versand ist abgeschlossen"
End Sub
Sub LeereZeilenLöschen()
Dim i As Long
Dim rng As Object
Dim lEmpty As Boolean
For i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
lEmpty = True
For Each rng In ActiveSheet.Rows(i).Cells
'sind alle Zelle leer ?
If rng.Value > "" Then
lEmpty = False
Exit For
End If
Next
If lEmpty = True Then
ActiveSheet.Rows(i).Delete
End If
Next i
End Sub
Sub Test2()
Dim olApp As Application ' war Object
Dim wsShell As Object ' war ohne Typ, also Variant
Dim iCounter As Long
If MsgBox("Soll der automatische E-Mail Versand gestartet werden?", _
vbYesNo + vbQuestion, "Frage") = vbNo Then Exit Sub
Sheets("Selektionsliste").Select ' Anweisung kam später
For iCounter = 1 To Cells(Rows.Count, 1).End(xlUp).Row ' war "To 2"
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.To = Cells(iCounter, 1)
.Subject = Cells(iCounter, 12)
.Body = Cells(iCounter, 14) & vbCrLf & vbCrLf & _
Cells(iCounter, 15) & vbCrLf & _
Cells(iCounter, 16) & vbCrLf & vbCrLf & _
Cells(iCounter, 17) & vbCrLf & vbCrLf & _
Cells(iCounter, 18) & vbCrLf
.Display
Set wsShell = CreateObject("WScript.Shell")
wsShell.AppActivate olApp
wsShell.SendKeys "%s"
Set wsShell = Nothing
Application.Wait Now + TimeValue("0:00:05")
End With
Next iCounter
Set olApp = Nothing
MsgBox "Der E-Mail Versand ist abgeschlossen"
End Sub
Option Explicit
Sub Test2()
Dim olApp As Object
Dim wsShell As Object ' war ohne Typ, also Variant
Dim iCounter As Long
If MsgBox("Soll der automatische E-Mail Versand gestartet werden?", _
vbYesNo + vbQuestion, "Frage") = vbNo Then Exit Sub
Sheets("Selektionsliste").Select ' Anweisung kam später
Set olApp = CreateObject("Outlook.Application") ' Anweisung kam später
For iCounter = 1 To Cells(Rows.Count, 1).End(xlUp).Row ' war "To 2"
With olApp.CreateItem(0)
.To = Cells(iCounter, 1)
.Subject = Cells(iCounter, 12)
.Body = Cells(iCounter, 14) & vbCrLf & vbCrLf & _
Cells(iCounter, 15) & vbCrLf & _
Cells(iCounter, 16) & vbCrLf & vbCrLf & _
Cells(iCounter, 17) & vbCrLf & vbCrLf & _
Cells(iCounter, 18) & vbCrLf
.Display
Set wsShell = CreateObject("WScript.Shell")
wsShell.AppActivate olApp
wsShell.SendKeys "%s"
Set wsShell = Nothing
Application.Wait Now + TimeValue("0:00:05")
End With
Next iCounter
Set olApp = Nothing
MsgBox "Der E-Mail Versand ist abgeschlossen"
End Sub