Daten aus Blatt in neue Mappe kopieren
17.02.2023 10:28:00
denpei
Das Ziel
Aus zwei verschiedenen Blättern einer Arbeitsmappe möchte ich gerne zwei neue Dateien mit entsprechendem Inhalt (jedoch nur Werte und Formatierung) erzeugen, die im weiteren Verlauf an eine Email angehängt werden sollen. Probleme bereitet mir nur der Teil des Codes, mit dem die Dateien erzeugt werden.
Der Ablauf:
- Inhalt aus geschützter Tabelle1 (A1:J35) kopieren (daher Blattschutz temporär aufheben)
- Nur Werte und Formatierung ohne Formeln in Tabelle16 einfügen
- Tabelle16 als neue Datei speichern
Das Gleiche dann nochmal mit Tabelle15 (s. Code u.).
Das Ergebnis
Beide Dateien werden erstellt. Die erste Datei ist inhaltlich korrekt. Die zweite Datei enthält jedoch die Werte aus der Quelle der ersten Datei und kurioser weise die Formatierung aus der Quelle der zweiten...?!
Was mache ich falsch?
Falls jemand sonst noch einen Tipp hat den Code effizienter zu machen, wäre ich sehr dankbar dafür.
Dim strDatei As String
Dim strDatei2 As String
Dim strPfad As String
Set outApp = CreateObject("Outlook.Application")
Set Mail = outApp.CreateItem(0)
strPfad = "C:\Users\Public"
With Tabelle1
.Unprotect
.Range("A1:J35").Copy
.Paste Destination:=Tabelle16.Cells(1)
.Protect
End With
With Tabelle16
.UsedRange.Value = ActiveSheet.UsedRange.Value
.Copy
End With
ActiveWorkbook.SaveAs strPfad & "\" & "Bestellung"
strDatei = ActiveWorkbook.FullName
Workbooks("Bestellung.XLSX").Close SaveChanges:=False
With Tabelle15
.Unprotect
.Range("A1:H14").Copy
.Paste Destination:=Tabelle17.Cells(1)
.Protect
End With
With Tabelle17
.UsedRange.Value = ActiveSheet.UsedRange.Value
.Copy
End With
ActiveWorkbook.SaveAs strPfad & "\" & "Transportauftrag"
strDatei2 = ActiveWorkbook.FullName
Workbooks("Transportauftrag.XLSX").Close SaveChanges:=False