Mappe unter Zellwert speichern
15.11.2007 08:51:00
Karel
Habe unterstehende code von Daniel erhalten lauft problemlos.
Kopiert 2 Tabelle in eine neue Mappe.
Habe nur noch eine Frage offen, wil gerne unter zellwert die in Tabelle ("Bedarfsermittlung") steht die neue Mappe ab Speichern wie / wo kann menn diese code snipsel einfügen in unterstehende code
dName = "C:\Test\" & _
.Range("I1") & " " & _
.Range("I2") & " " & _
.Range("I3") & ".xls")
Sub UnterNamenSpeichern()
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim wsNeu1 As Worksheet, wsNeu2 As Worksheet
Dim dName$
Dim i As Long
Set ws1 = ThisWorkbook.Worksheets("Bedarfsermittlung")
Set ws2 = ThisWorkbook.Worksheets("Order-Supplier")
Set wb = Workbooks.Add
Set wsNeu1 = wb.Sheets(1)
Set wsNeu2 = wb.Sheets(2)
wsNeu1.Name = ws1.Name
ws1.Cells.EntireColumn.Hidden = False
ws1.Cells.EntireRow.Hidden = False
ws1.Cells.EntireColumn.Copy
wsNeu1.Cells(1, 1).PasteSpecial xlPasteValues
ws1.Cells.Copy
wsNeu1.Cells(1, 1).PasteSpecial xlPasteFormats
wsNeu2.Name = ws2.Name
ws2.Cells.EntireColumn.Hidden = False
ws2.Cells.EntireRow.Hidden = False
ws2.Cells.EntireColumn.Copy
wsNeu2.Cells(1, 1).PasteSpecial xlPasteValues
ws2.Cells.Copy
wsNeu2.Cells(1, 1).PasteSpecial xlPasteFormats
For i = 1 To 56
ActiveWorkbook.Colors(i) = ThisWorkbook.Colors(i)
Next
End Sub
Grusse
Karel
Anzeige