Hallo Inga,
in deiner Frage hattest du nur einen Teil des Makros gepostet, nämlich den Teil mit dem E-Mail-Versand. Der Teil mit dem Kopieren hat gefehlt. Daher war ich davon ausgegangen, dass es zum Kopieren der Daten ein eigenes Makro gibt.
Hier jetzt mal der neue bearbeitete Code, mit dem Vorschlag von Karin zum Ersetzen der 0 und 1:
Sub LM()
'
' LM Makro
'
Dim WkSh_Q As Worksheet
Dim WkSh_Z As Worksheet
Dim rZelle As Range
Dim aUeberschr As Variant
Dim iIndx As Integer
Dim iSpalte As Integer
Dim sPath As String
Dim strUser As String
Dim strPfad As String
Dim strSignatur As String
Dim Body As String
Dim Nachricht As Object, OutlookApplication As Object
Dim Anhang As String
aUeberschr = Array("Lager Nr.", "Art.-Nr.", "Art.-Bez.", "Sortimentskennzeichen", "WG", "Verfügbarer Bestand", "Summe Best. (sync, BT)", "Durchschn. Tagesabgang", "Erster Zugang", "Letzter Wareneingang", "Letzter Abgang", "Nicht disponieren", "Min. SiB")
'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
Set WkSh_Q = Worksheets("Logomate Quelle") ' das Quell-Tabellenblatt
Set WkSh_Z = Worksheets("Filiale") ' das Ziel-Tabellenblatt
With WkSh_Q.Rows(1)
For iIndx = 0 To UBound(aUeberschr)
Set rZelle = .Find(aUeberschr(iIndx), LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
iSpalte = iSpalte + 1
WkSh_Q.Columns(rZelle.Column).Copy Destination:=WkSh_Z.Columns(iSpalte)
End If
Next iIndx
End With
'Tabellenblatt Filiale in neues Workbook kopieren
Worksheets("Filiale").Copy
'dieses Workbook temporär im Pfad des ursprünglichen Workbooks mit Namen des Tabellenblatt speichern
'dazu wird Pfad und Name in Variable hinterlegt
strVersanddatei = ThisWorkbook.Path & "\" & ActiveSheet.Name & ".xlsx"
With ActiveWorkbook
.SaveAs strVersanddatei 'speichern
'in Spalte L die Werte 0 und 1 ersetzen
With Worksheets(1)
.Columns(12).Replace What:="0", Replacement:="""nicht Dispo""", LookAt:= _
xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Columns(12).Replace What:="1", Replacement:="""Dispo""", LookAt:= _
xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Spalten auf optimale Breite formatieren
.UsedRange.Columns.AutoFit
End With
.Close (True) 'Änderungen speichern und schließen
End With
'hier wird die neue Datei als Anhang zugewiesen
Anhang = strVersanddatei
Set OutlookApplication = CreateObject("Outlook.Application")
Set Nachricht = OutlookApplication.CreateItem(0)
With Nachricht
.To = "Empfänger eingeben"
.Subject = "MinSiB Liste"
.Attachments.Add Anhang
'Namen der Signatur definieren
strSignatur = "Standard"
strUser = Environ("Userprofile")
strPfad = strUser & "\AppData\Roaming\Microsoft\Signatures\" & strSignatur & ".htm"
.htmlBody = "<html><body><p>Sehr geehrte Damen und Herren,</p><p>im Anhang erhalten Sie die angeforderte MinSiB Liste. </p>Bitte tragen Sie Ihre Änderungen in die <b>Spalte N</b> ein und senden die Exceltabelle per e-mail an <b>Dispo-Einkauf@Kibek.de</b> zurück.<br> Bei Rückfragen steht Ihnen das Dispositionsteam gern zur Verfügung.<p>Vielen Dank.<p><p></p>" & test(strPfad) & "</body></html>"
.Display
'.Mail.Send
End With
Set OutlookApplication = Nothing
Set Nachricht = Nothing
'temporäre Datei mit einzelnem Tabellenblatt wieder löschen
Kill (strVersanddatei)
Application.ScreenUpdating = True
End Sub
Schau mal, ob das jetzt so funktioniert, wie du willst.
Gruß
M.O.