Rückkehr zur Quelldatei nach Versand einer Kopie

06.02.2025 17:37:02

pschaupp

Hallo Zusammen,

benötige mal Euer Schwarmwissen. Leider komme ich alleine nicht weiter.

Ich kopiere einen Reiter einer Excelliste in eine neue Arbeitsmappe. Wandle dort alle Formeln in Werte um.
Bis dahin funktioniert alles ganz gut.
Nun möchte ich die neue Datei abspeichern, schließen und bei der Quelldatei zum nächsten Reiter wechseln, um den gleichen Vorgang zu wiederholen. Doch
den letzten Schritt bekomme ich nicht hin. Hier ein Auszug aus meinem Makro:

If Range("b2").Value > "" Then
Sheets(strBlatt).Copy
Cells.Select
Selection.Copy
Range("A1").Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B2").Select
ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name & ".xlsx"
End If
ActiveSheet.Next.Activate
On Error GoTo Ende
Next
Ende:
Sheets("Zusammenfassung").Select
Range("B2").Select
End Sub

Hoffe ihr könnt mir helfen.
LG. Peggy

AW: Rückkehr zur Quelldatei nach Versand einer Kopie

06.02.2025 17:53:06

Beverly

Hi Peggy,

wenn du nach der Zeile

ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name & ".xlsx"

noch dieses einfügst:

ActiveWorkbook.Close

wird die Kopie geschlossen und du kehrst automatisch zur Quelldatei zurück.

Bis später
Karin

Link zur Homepage: https://excel-inn.de/

AW: Rückkehr zur Quelldatei nach Versand einer Kopie

06.02.2025 19:20:41

pschaupp

Hallo Beverly, vielen Dank für die schnelle Antwort. Leider funktioniert es nicht wie gewünscht und das Makro bleibt immer wieder an der selben Stelle hängen,
weil es den Reiter Zusammenfassung der Quelldatei nicht findet.

hier mal der komplette Code:

Sub Schaltfläche4_Klicken()

Dim ws As Worksheet
For Each ws In Worksheets

Dim strBlatt As String
Dim strDatei As String
Dim strPfad As String
Dim outObj As Object
Dim Mail As Object
Dim strBodyText As String
Dim i%
Set outObj = CreateObject("Outlook.Application")
Set Mail = outObj.CreateItem(0)
strPfad = "C:\Temp" 'entsprechend anpassen
'** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
strBlatt = ActiveSheet.Name
'** Gewähltes Tabellenblatt kopieren
If Range("b2").Value > "" Then
Sheets(strBlatt).Copy
Cells.Select
Selection.Copy
Range("A1").Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B2").Select
ActiveWorkbook.SaveAs strPfad & "\" & ActiveSheet.Name & ".xlsx"

'** Pfad und Dateiname der neuen Datei zwischenspeichern
strDatei = ActiveWorkbook.FullName

'** Body-Text festlegen
strBodyText = "Sehr geehrte Damen und Herren," & Chr(13) & Chr(13) & _
"bla, bla, bla." & Chr(13) & Chr(13) & _
"Mit freundlichen Grüßen"

'** Mail erzeugen
With Mail
.To = ActiveSheet.Range("p1")
'.CC = "sandra.neumann@fuchs.de; iris.eichhorn@fuchs.de"
'.Subject = ActiveWorkbook.Name 'Betreff
.Subject = ThisWorkbook.Name
.BodyFormat = 2 '2 = HTML, 1 = Text
.Attachments.Add strDatei 'Anhang
.Body = strBodyText 'Bodytext / Signatur
End With
Workbooks(Dir(strDatei)).Close
Kill (strDatei)
Mail.send
End If
ActiveSheet.Next.Activate
On Error GoTo Ende
Next
Ende:
Sheets("Zusammenfassung").Select
Range("B2").Select
MsgBox "E-Mails alle versendet!"
End Sub

Also das Blatt soll kopiert, dann komplett in Werte umgewandelt, gespeichert und versendet werden.
Habe es auch mit Deiner Antwort probiert. Leider hängt es sich immer bei sheets("Zusammenfassung").select auf, obwohl es den Reiter in der Quelldatei gibt.
Haben den Namen und Schreibweise bereits mehrfach geprüft, auch auf Leerzeichen.

Hoffe Du kannst noch einmal darüber schauen, oder es hat noch jemand eine Idee.

Vielen Dank.

AW: Rückkehr zur Quelldatei nach Versand einer Kopie

06.02.2025 19:54:52

Beverly

Hi Peggy,

ersetze mal die beiden Zeilen

Sheets("Zusammenfassung").Select

Range("B2").Select

durch diese Zeile

Application.Goto reference:=ThisWorkbook.Worksheets("Zusammenfassung").Range("B2")

Bis später
Karin

Link zur Homepage: https://excel-inn.de/

AW: Rückkehr zur Quelldatei nach Versand einer Kopie

06.02.2025 20:17:20

pschaupp

Hallo Karin,

habe den Fehler gefunden. Danke für Deine Hilfe.

Habe

ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

durch

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ersetzt.

Jetzt passt es.

Schönen Abend noch und großes Dankeschön.

LG

Peggy

AW: Rückkehr zur Quelldatei nach Versand einer Kopie

06.02.2025 20:49:13

Onur

Sorry, ich kann es mir nicht verkneifen, denn "da kriesch Plach", wenn ich sowas höre.
Diese 3 Schaltflächen, auf die du draufklicken kannst, um zu den entsprechenden Blättern zu gelangen, sind die Reiter (so wie die im Karteikasten).

Userbild

Was du aber die ganze Zeit meinst, sind die (Arbeits-) Blätter.
Das Zündschloss ist ja auch nicht der Motor, damit kannst du nur den Motor starten.

AW: Rückkehr zur Quelldatei nach Versand einer Kopie

06.02.2025 22:01:11

emkaes

Hallo Peggy,

dein Code ist für mich ziemlich unleserlich und durcheinander. Daher auch nicht leicht zu verstehen.
Du wirbelst mit activesheet.cells und cells.select und selection umher, ohne eine eindeutige Referenz.
Mit deinem Code hast du nun zufällig (? ) ein funktionierendes Makro.
Wenn du keine besonderen Formatierungen in deinen Tabellenblättern hast, sondern lediglich die Werte brauchst, solltest du auf Daten im Array umsteigen.
Ich habe dir deinen Code mal umgefriemelt und die Referenzierung so ergänzt, wie ich deinen Code verstanden habe

Sub Schaltfläche4_Klicken()

Dim wks As Worksheet, wkb As Workbook

Dim arr As Variant

Dim strPfad As String, strDatei As String

Dim outObj As Object

Dim strBodyText As String, strToAddress  As String



strPfad = "C:\Temp\"



'** Body-Text festlegen

strBodyText = "Sehr geehrte Damen und Herren," & Chr(13) & Chr(13) & _

"bla, bla, bla." & Chr(13) & Chr(13) & "Mit freundlichen Grüßen"



Set outObj = CreateObject("Outlook.Application")



For Each wks In ThisWorkbook.Worksheets

    '** durch alle Tabellenblätter iterieren, 

     ' wenn jeweils B2 gefüllt,  Daten  in Array einlesen und in neue Arbeitsmappe ausgeben

    If wks.Range("b2").Value > "" Then

       arr = wks.UsedRange.Value

       Set wkb = Workbooks.Add(-4167)

       wkb.Worksheets(1).Cells(1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr

       wkb.SaveAs strPfad & wks.Name, 51

       strToAddress = wks.Range("P1").Value

       strDatei = wkb.FullName

       wkb.Close , False

    

        '** Mail erzeugen

        With outObj.CreateItem(0)

          .To = strToAddress

          .Subject = ThisWorkbook.Name    ' das ist der Name der Originaldatei!!!!!  Willst du das wirklich?

          .BodyFormat = 2 '2 = HTML, 1 = Text

          .Attachments.Add strDatei 'Anhang

          .Body = strBodyText 'Bodytext / Signatur

          .send

        End With

        

   End If

Next

End Sub

Code ist nur auf die Erstellung der Dateien getestet, Outlook habe ich nicht in Gebrauch

VG emkaes

AW: Rückkehr zur Quelldatei nach Versand einer Kopie

06.02.2025 20:06:50

pschaupp

Hallo Karin,

das Makro läuft zwar jetzt ohne Fehler durch. Macht aber leider nicht das was es soll.
Das gewünschte Blatt wird zwar kopiert, aber dann springt das Makro gleich wieder in die Quelldatei, ohne vorher die Daten zu kopieren und als Werte einzufügen.
Auch das speichern, versenden per Mail und schließen fehlt.

LG.

Peggy

Rückkehr zur Quelldatei nach Versand einer Kopie

Forumthread: Rückkehr zur Quelldatei nach Versand einer Kopie

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Rückkehr zur Quelldatei nach Versand einer Kopie

Forumthread: Rückkehr zur Quelldatei nach Versand einer Kopie

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread