excel vba sheet erstellen und versenden
29.09.2020 23:37:11
Jan
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