AW: Tabelle in neue leere Arbeitsmappe
22.09.2014 19:13:06
Matze
Hallo Martin,
VBA Level wirklich gut?
Na mal sehn ob du damit klar kommst:
Option Explicit
Sub export()
Dim rng As Range
Dim objWB As Workbook
Dim strName As String, strPath As String
On Error GoTo ErrExit
GMS
strPath = "C:\Archiv\Rechnung" 'Speicherpfad - Anpassen!
If Right(strPath, 1) "\" Then strPath = strPath & "\"
With Sheets("Rechnung") 'zu exportierende Tabelle - Anpassen!
Set rng = .Range("$A$1:$F$70") 'Bereich anpassen der exportiert werden soll
strName = .Range("F6").Text & ".xls" 'Zelle mit dem zu vergebenden Namen - Anpassen!
End With
Set objWB = Workbooks.Add(xlWBATWorksheet)
rng.Copy
With objWB.Sheets(1).Range("A1")
.PasteSpecial -4163
.PasteSpecial -4122
.PasteSpecial 6
.PasteSpecial 8
End With
Range("A1").Select
Application.CutCopyMode = False
ActiveWindow.DisplayZeros = False ' keine Nullenanzeige
objWB.SaveAs strPath & strName
objWB.Close
MsgBox "Daten wurden in C:\Archiv\Rechnung gespeichert", vbOKOnly
ErrExit:
If Err.Number 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"
GMS True
Set rng = Nothing
Set objWB = Nothing
End Sub
Public Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Not Modus Then lngCalc = .Calculation
If Modus And lngCalc = 0 Then lngCalc = -4105
.Calculation = IIf(Modus, lngCalc, -4135)
.Cursor = IIf(Modus, -4143, 2)
End With
End Sub
Gruß Matze