Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Tabelle in neue leere Arbeitsmappe

Betrifft: Tabelle in neue leere Arbeitsmappe von: Martin
Geschrieben am: 22.09.2014 15:37:17

Liebe Kollegen,

ich möchte per VBA die Aktive Tabelle in meiner Arbeitsmappe in eine neue leere Arbeitsmappe kopieren und dann die neue Arbeitsmappe unter einem bestimmten Namen speichern und schliessen und danach wieder zurück auf meine erste Arbeitsmappe.

Danke
Martin

  

Betrifft: AW: Tabelle in neue leere Arbeitsmappe von: Matze Matthias
Geschrieben am: 22.09.2014 19:13:06

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


 

Beiträge aus den Excel-Beispielen zum Thema "Tabelle in neue leere Arbeitsmappe"