VBA Schleife Zellen auswählen und selektieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: VBA Schleife Zellen auswählen und selektieren
von: Andreas Herdin
Geschrieben am: 08.06.2015 14:34:45

Hallo,
trotz langem Suchen habe ich keine Lösung gefunden. Ich hoffe Ihr könnt mich helfen.
Folgende Ausgangssituation:
- Mappe „Makro“ befindet sich nur ein Button mit meiner Makro.
- In der Mappe „Daten“ befinden sich alle Informationen die selektiert und kopiert werden sollen.
- Mappe „Namen“ beinhaltet in Spalte A die Suchkriterien für die Mappe “Daten“.
Ich benötige eine Schleife die automatisch die Zelle A2 aus der Mappe „Daten“ auswählt und anschließend den Wert als Suchkriterium in Tabelle1 (Mappe Daten) einsetzt.
Das daraus resultierende Ergebnis soll anschließend in eine neue Excel Datei kopiert, abspeichert und per Mail versendet werden.
Wenn dies erfolgt ist soll das Prozedere erneut, allerdings mit A3, starten. Solange bis zur ersten leeren Zelle in Spalte A.
Anbei findet Ihr meine ersten Versuche. Das Problem liegt bei mir darin, dass ich nicht den Sprung in die nächste Zelle schaffe und dieses als Suchkriterium zu verwenden.
Das speichern und versenden klappt super. Nur das Suchen nicht.

Sub Anhang()
'
' Anhang Makro
'
betreff = Worksheets("Daten").Range("B3").Value
'Betreff für die Mail hinterlegen
betreff1 = Range("B7").Value
'Betreff1 für die Mail hinterlegen
empfaenger = Worksheets("Daten").Range("W2").Value
'Empfänger für die Mail hinterlegen
 'A12 = Worksheets("Daten").Range("A2").Value
Dim Speicherpfad As String
Speicherpfad = "\\bosch.com\dfsrb\DfsDE\Loc\Sw\bank\C:\temp"
  AnzZeilen = ActiveSheet.UsedRange.Rows.Count
'i = Worksheets("Daten").Range("B2").Value
Dim lAnzahl As String
 
Anf:
 lAnzahl = InputBox("Wie oft soll das Makro laufen ?", , 3)
 If lAnzahl = "" Then Exit Sub
 
 'Prüfen ob eine Zahl eingegeben wurde
 If IsNumeric(lAnzahl) Then
 For i = 1 To CLng(lAnzahl)
    Sheets("Namen").Select
    Range("A2").Select
    AnzZeilen = ActiveSheet.UsedRange.Rows.Count
    Selection.Copy
    Sheets("Daten").Select
    ActiveSheet.ListObjects("Tabelle1").Range.AutoFilter Field:=1, Criteria1:=Worksheets("Namen" _
).Range("A2"), Operator:=xlAnd
    Cells.Select
    
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
   Application.DisplayAlerts = False
 Sheets(Array("Tabelle2", "Tabelle3")).Delete
 Application.DisplayAlerts = True
   
'Speichern
Const LW = "C:\"
Const Pfad = "\\bosch.com\dfsrb\DfsDE\Loc\Sw\bank\C:\temp"
ChDrive LW
ChDir _
        "C:\temp"
    ActiveWorkbook.SaveAs Filename:=Range("A2") & "-" & "Offene_WF" & " - " & Date & " - " &  _
Format(Time, "hh-mm-ss") & ".xlsm" _
        , FileFormat:=52, CreateBackup:=False
'Per Mail versenden
     Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String
AWS = ActiveWorkbook.FullName
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = empfaenger
.Subject = "Offene WF -" & "/ " & Date
.attachments.Add AWS
.Body = "Hallo," & vbCrLf & "anbei finden…." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & " _
Mit freundlichen Grüßen" & vbCrLf & Range("B12")
.Display
End With
Set OutApp = Nothing
Set Nachricht = Nothing
SendKeys "%s", True
         SendKeys "^{ENTER}", True
         
         Set objEMail = Nothing
ActiveWorkbook.Close SaveChanges:=False
 Next
 Else
 MsgBox "Bitte ein Zahl eingeben !", vbInformation
 GoTo Anf
 End If
 End Sub

Bild

Betrifft: AW: VBA Schleife Zellen auswählen und selektieren
von: fcs
Geschrieben am: 09.06.2015 10:27:27
Hallo Andreas,
leider in deiner Frage und im Makro einiges durcheinander.
Kurz Begriffe in Excel:
Mappe/Arbeitsmappe/Workbook = Excel-Datei
Tabelle/WorkSheet = Tabellenblatt innerhalb einer Arbeitsmappe
"Makro", "Daten", "Namen" sind also Tabellenblätter innerhalb deiner Mappe.
In deinem Makro belgst du viele Variablen (betreff, betreff1, Speicherpfad, Pfad etc) mit Werten. Diese Variablen werden aber nicht verwendet.
Überfüssige, verwirrende Code-Zeilen sollte man vermeiden.
Ich hab jetz mal versucht etwas aus deinem Gerüst zu machen, aber kann keine Garantie für Funktion geben. An einigen unklaren Stellen hab ich Kommentare mit Fragen eingefügt.
Gruß
Franz

Sub Anhang()
'
' Anhang Makro
  Dim wksNamen As Worksheet
  Dim wksDaten As Worksheet
  Dim wkbAnhang As Workbook
  Dim varSuchen
  Dim Zeile As Long
  Dim empfaenger
  
  Dim Nachricht As Object, OutApp As Object
  Dim AWS As String
'
  Set wksDaten = ActiveWorkbook.Worksheets("Daten")
  Set wksNamen = ActiveWorkbook.Worksheets("Namen")
  empfaenger = wksDaten.Range("W2").Value
  'Empfänger für die Mail hinterlegen       'Sind die identisch für alle Mails?
  
  If MsgBox("E-Mails für Namen verteilen ?", vbQuestion + vbOKCancel, _
        "E-Mails erstellen") = vbCancel Then Exit Sub
  Set OutApp = CreateObject("Outlook.Application")
   
  With wksNamen
    Zeile = 2 'Startzeile für Filterwerte in Blatt Namen
    Do Until .Cells(Zeile, 1).Text = ""
        varSuchen = .Cells(Zeile, 1).Value
        With wksDaten
          .ListObjects("Tabelle1").Range.AutoFilter Field:=1, _
              Criteria1:=varSuchen, Operator:=xlAnd
          .Cells.Copy
          
          Set wkbAnhang = Workbooks.Add(Template:=xlWBATWorksheet) 'Workbook mit einem  _
Tabellenblatt
          ActiveSheet.Paste
          Application.CutCopyMode = False
        End With
      'Speichern
      
        Const LW = "C:\"
        Const Pfad = "\\bosch.com\dfsrb\DfsDE\Loc\Sw\bank\C:\temp" 'überflüssig???
        ChDrive LW
      
        ChDir "C:\temp"
        wkbAnhang.SaveAs Filename:=varSuchen & "-" & "Offene_WF" & " - " _
            & Date & " - " & Format(Time, "hh-mm-ss") & ".xlsm", _
            FileFormat:=52, CreateBackup:=False
        
      'Per Mail versenden
        AWS = wkbAnhang.FullName
        wkbAnhang.Close SaveChanges:=False
'GoTo Test01 - überspringen der E-Mailerstellung zum Testen
        Set Nachricht = OutApp.CreateItem(0)
        With Nachricht
          .To = empfaenger
          .Subject = "Offene WF -" & "/ " & Date
          .attachments.Add AWS
          .Body = "Hallo," & vbCrLf & "anbei finden…." & vbCrLf & vbCrLf & vbCrLf & _
              vbCrLf & vbCrLf & _
              "Mit freundlichen Grüßen" & vbCrLf & Range("B12") 'Wo befindet sich Zelle B12 ?
          .Display
        End With
        
'Was sollen die SendKeys-Befehle bewirken?
        SendKeys "%s", True
        SendKeys "^{ENTER}", True
        
        Set Nachricht = Nothing
'Test01:
        Zeile = Zeile + 1
     Loop
  End With
  Set OutApp = Nothing
End Sub


Bild

Betrifft: AW: VBA Schleife Zellen auswählen und selektieren
von: Andreas Herdin
Geschrieben am: 11.06.2015 09:29:33
Hi Franz,
das funktioniert klasse. Vielen Dank! :)
Einziger Haken ist die E-Mail Adresse. Die Empfänger sind unterschiedlich, allerdings befindet sich immer in der neu erzeugten Datei in Zelle W2 die E-Mail Adresse. Wie kann ich die einfügen?
Gruß

Bild

Betrifft: AW: VBA Schleife Zellen auswählen und selektieren
von: fcs
Geschrieben am: 11.06.2015 13:11:41
Hallo Andreas,
ergänze in folgenden Abschnitt des Makros das Speichern der E-Mail-Empfänger in der Variablen.

      'Per Mail versenden
        AWS = wkbAnhang.FullName
        'Empfänger für die Mail speichern
        empfaenger = wkbAnhang.Worksheets(1).Range("W2").Text
        wkbAnhang.Close SaveChanges:=False
'GoTo Test01 - überspringen der E-Mailerstellung zum Testen

Gruß
Franz

 Bild

Beiträge aus den Excel-Beispielen zum Thema "VBA Schleife Zellen auswählen und selektieren"