Microsoft Excel

Herbers Excel/VBA-Archiv

excel vba sheet erstellen und versenden

Betrifft: excel vba sheet erstellen und versenden von: Jan
Geschrieben am: 29.09.2020 23:36:45

Hallo zusammen, ich hoffe ihr könnt mir helfen.
Ich habe folgendes Problem:
Ich habe eine "MainPage" mit angaben von Unternehmensnamen (A8 und darunter) und deren E-Mail Adressen (B8 und darunter).
Daneben wird aus einem Report ein Tabellenblatt kopiert, der Name des Sheet lautet Station.
Makro:
Dieses soll überprüft werden, ob in Spalte 6 einer der Unternehmensnamen angegeben ist. Wenn ja, dann soll ein neues Sheet erstellt werden und alle Zeilen in denen der Wert=True ist dort hinein kopiert werden. Anschließend wird das Sheet noch per Outlook an die hinterlegte E-Mail Adresse geschickt und danach gelöscht. Ich habe mir zum verschicken und löschen schon andere Subs geschrieben und das klappt auch soweit.
Da ich kein Excel-Pro bin, muss ich alle Werte die er suchen soll einzeln auflisten -> es sollen später ca. 30 verschiedene Werte abgefragt werden, was viel Schreibarbeit bedeutet -> vielleicht kann man das noch vereinfachen.

Mein Problem, warum ich mich an euch wende ist folgendes:
Mein Code funktioniert nur bei dem ersten Wert. Code unten anbei -> die Suche nach dem 2. Wert habe ich auskommentiert.
Wenn ich nach einem Wert suche, dann macht es alles genau so wie gewollt, lasse ich allerdings einen zweiten Wert suchen (dsp2) dann funktioniert die Boolean nicht und ich bekomme den Fehler:
"Index außerhalb des gültigen Bereichs" -> es wurde kein Sheet mit dem Namen (Wert=dn2) erstellt und daher kann nichts eingefügt werden.
Warum geht das nur bei der ersten "Suche".

Eine weitere Frage: Wenn ich nur die eine Suche habe ist es einfach das "Ergebnis" (Sheet) anschließend zu verschicken. Wo muss ich den Code zum Verschicken einfügen, wenn er die Schleife durchgeht? Habe es nicht hinbekommen. Er hat dann immer für jede kopierte Zeile eine Mail erstellt.
Ich hoffe ihr könnt mir helfen. Sitze schon seit 2 Tagen an dem Code und bin am Verzweifeln.
Voll fettes Danke schon mal vorab, an alle die es versuchen!

Sub Copy_DSP()

Dim Zeile As Long
Dim ZeileMax As Long
Dim d1, d2, d3, d4, d5 As Long
Dim dsp1, dsp2, dsp3, dsp4, dsp5 As String
Dim dspm1, dspm2, dspm3, dspm4, dspm5 As String
Dim dn1, dn2, dn3, dn4, dn5 As Long
Dim WsTabelle As Worksheet
Dim BoVorhanden As Boolean

'Namen der Unternehmen
dsp1 = Sheets("MainPage").Range("A8").Value
dsp2 = Sheets("MainPage").Range("A9").Value
dsp3 = Sheets("MainPage").Range("A10").Value
dsp4 = Sheets("MainPage").Range("A11").Value
dsp5 = Sheets("MainPage").Range("A12").Value

'E-Mail Adressen der Unternehmen
dspm1 = Sheets("MainPage").Range("B8").Value
dspm2 = Sheets("MainPage").Range("B9").Value
dspm3 = Sheets("MainPage").Range("B10").Value
dspm4 = Sheets("MainPage").Range("B11").Value
dspm5 = Sheets("MainPage").Range("B12").Value

'Namen der Sheets die erstellt werden wenn das Unternehmen gefunden wurde
dn1 = dsp1 & " " & "ZB" & " " & Date
dn2 = dsp2 & " " & "ZB" & " " & Date
dn3 = dsp3 & " " & "ZB" & " " & Date
dn4 = dsp4 & " " & "ZB" & " " & Date
dn5 = dsp5 & " " & "ZB" & " " & Date

'Zeilen in denen die kopierten Zeilen eingefügt werden sollen
d1 = 1
d2 = 1
d3 = 1
d4 = 1
d5 = 1

With Sheets("Station")
ZeileMax = .UsedRange.Rows.Count
For Zeile = 2 To ZeileMax

'Checken, ob dsp1 in dem Sheet vorhanden ist
If Sheets("Station").Cells(Zeile, 6).Value = dsp1 Then

'Checken, ob schon ein Tabellenblatt mit dem Namen vorhanden ist. Wenn ja dann = nichts
For Each WsTabelle In Sheets
        If WsTabelle.Name = dn1 Then
            BoVorhanden = True
        End If

'Wenn noch kein Tabellenblatt mit dem Namen vorhanden ist, dann wird eins erstellt.
Next WsTabelle
        If BoVorhanden = False Then
        Sheets.Add.Name = dn1

        'Die erste Zeile aus der Liste wird als Überschrift einmal mit kopiert
        Sheets("Station").Rows(1).Copy Destination:=Sheets(dn1).Rows(1)
        d1 = d1 + 1
        End If

        'Es werden alle Zeilen kopiert, bei denen der Wert=true ist.
        Sheets("Station").Rows(Zeile).Copy Destination:=Sheets(dn1).Rows(d1)
        d1 = d1 + 1
End If

'Wenn ich versuche das Makro nach einem weiteren Wert suchen zu lassen,
'dann erhalte ich den Fehler
'"Index außerhalb des gültigen Bereichs" -> es wurde kein Sheet mit dem 
'Namen (Wert=dn2) erstellt.
'warum funktioniert das oben, beim ersten Mal, aber nicht bei allen weiteren?
'If Sheets("Station").Cells(Zeile, 6).Value = dsp2 Then
'For Each WsTabelle In Sheets
'        If WsTabelle.Name = dn2 Then
'            BoVorhanden = True
'        End If
'
'        Next WsTabelle
'        If BoVorhanden = False Then
'        Sheets.Add.Name = dn2
'        Sheets("Station").Rows(1).Copy Destination:=Sheets(dn2).Rows(1)
'        d2 = d2 + 1
'        End If
'
' ### Hier erscheint beim Debug der Fehler, dass der Index außerhalb des Bereichs 
'liegt (weil zuvor kein Tabellenblatt mit dem Namen erstellt wurde)###       
'Sheets("Station").Rows(Zeile).Copy Destination:=Sheets(dn2).Rows(d2)
'        d2 = d2 + 1
'End If
'
'#### Es sollte idealerweise eine Schleife sein, die so lange weiter geht, 
'bis in Sheets("MainPage") unter A8 keine weiteren Einträge sind

Next Zeile

'Bei nur einem Wert kann ich das versenden der E-Mail an das Ende stellen, 
'aber es soll jedes erstellte Sheet einzeln, an den 'richtigen Empfänger geschickt 
'werden, da weiß ich nicht genau wohin mit dem Code.
'Call SendMail.DSPMail

End With
End Sub

Betrifft: AW: excel vba sheet erstellen und versenden
von: Hajo_Zi
Geschrieben am: 30.09.2020 05:29:52

Du solltest die Variable vor For auf false setzen.

Zu Deiner Datei kann ich nichts schreiben, was wohl daran liegt das ich nicht auf fremde Rechner schaue.Ich baue keine Datei nach.

Sollte die Datei verlinkt werden?

Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten
http://www.ms-office-forum.de/forum/showthread.php?t=322895
änderrn.

Bilder lade ich mir nicht runter, da Excel damit nichts anfangen kann.

http://www.excel-ist-sexy.de/bilder-statt-datei/

Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.

Das ist nur meine Meinung zu dem Thema.

GrußformelHomepage