Code ändern - neues Arbeitsblatt in neuer Datei

Bild

Betrifft: Code ändern - neues Arbeitsblatt in neuer Datei
von: Wolfango
Geschrieben am: 12.10.2015 13:52:50

Hallo zusammen,
dank dieses (hochgeschätzten) Forums habe ich untenstehenden VBA-Code erhalten.
Dieser soll nun ein wenig verändert werden. Das Makro soll nun nicht mehr ein Arbeitsblatt in der vorhandenen Arbeitsmappe anlegen, sondern das neue Blatt in einer völlig neuen (noch nicht gespeicherten) Mappe/Datei anlegen.
Wie muss der Code verändert werden, damit dies passiert?
Danke vorab für's Nachdenken!
Gruß,
Wo

Sub formular()
  Dim lngI As Long
  Dim objSh As Worksheet, objActive As Worksheet
  Set objActive = ActiveSheet
  
  On Error GoTo ErrExit
  
  Application.ScreenUpdating = False
  
  Do While lngI < 99
    lngI = lngI + 1
    If Not SheetExist("Formular " & objActive.Range("I2")) Then
      Set objSh = ThisWorkbook.Worksheets.Add(after:= _
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
      objSh.Name = "Formular " & objActive.Range("I2")
      objActive.Range("A1:K20").Copy
      With objSh.Range("A1")
        .PasteSpecial -4163
        .PasteSpecial -4122
        .PasteSpecial xlPasteColumnWidths
        .Select
      End With
      objActive.Activate
      Exit Do
    End If
  Loop
  
ErrExit:
  With Application
    .CutCopyMode = False
    .ScreenUpdating = True
  End With
  
  Set objActive = Nothing
  Set objSh = Nothing
End Sub

Bild

Betrifft: AW: Code ändern - neues Arbeitsblatt in neuer Datei
von: ChrisL
Geschrieben am: 12.10.2015 14:00:38
Hi Wolf

Sub formular()
  Dim lngI As Long, WB As Workbook
  Dim objSh As Worksheet, objActive As Worksheet
  
  Set WB = Workbooks.Add
  Set objActive = WB.ActiveSheet
  
  On Error GoTo ErrExit
  
  Application.ScreenUpdating = False
  
  Do While lngI < 99
    lngI = lngI + 1
    If Not SheetExist("Formular " & objActive.Range("I2")) Then
      Set objSh = ThisWorkbook.Worksheets.Add(after:= _
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
      objSh.Name = "Formular " & objActive.Range("I2")
      objActive.Range("A1:K20").Copy
      With objSh.Range("A1")
        .PasteSpecial -4163
        .PasteSpecial -4122
        .PasteSpecial xlPasteColumnWidths
        .Select
      End With
      objActive.Activate
      Exit Do
    End If
  Loop
  
ErrExit:
  With Application
    .CutCopyMode = False
    .ScreenUpdating = True
  End With
  
  Set objActive = Nothing
  Set objSh = Nothing
End Sub

cu
Chris

Bild

Betrifft: AW: Code änd. - neues Arbeitsblatt in neuer Datei
von: Wolfango
Geschrieben am: 12.10.2015 14:51:27
....Danke für die schnelle Antwort!
Leider funktioniert es bei mir nicht...(beim Ausführen wird eine neue Datei angelegt, die aber leer ist...)
Vielleicht setze ich besser noch mal bei der gewünschten Funktionalität an....das Makro soll folgendes machen:
1. das aktuelle Arbeitsblatt soll in eine neue leere Datei kopiert werden.
2. der Name des Arbeitsblattes soll sein: "Formular" & I2" (=Eintrag in Zelle I2)
3. alle Formeln des Arbeitsblattes sollen in Werte gewandelt werden (dieser letzte Punkt ist neu, aber wenn wir schon mal dabei sind...)
Vielen Dank und Gruß,
Wo

Bild

Betrifft: AW: Code änd. - neues Arbeitsblatt in neuer Datei
von: ChrisL
Geschrieben am: 12.10.2015 15:21:53
hi
Mein Fehler, so sollte es gehen...

Sub formular()
  Dim lngI As Long, WB As Workbook
  Dim objSh As Worksheet, objActive As Worksheet
  
  Set objActive = ActiveSheet
  Set WB = Workbooks.Add
  Set objSh = WB.ActiveSheet
  
  On Error GoTo ErrExit
  
  Application.ScreenUpdating = False
  
  Do While lngI < 99
    lngI = lngI + 1
      objSh.Name = "Formular " & objActive.Range("I2")
      objActive.Range("A1:K20").Copy
      With objSh.Range("A1")
        .PasteSpecial -4163
        .PasteSpecial -4122
        .PasteSpecial xlPasteColumnWidths
        .Select
      End With
      objActive.Activate
      Exit Do
  Loop
  
ErrExit:
  With Application
    .CutCopyMode = False
    .ScreenUpdating = True
  End With
  
  Set objActive = Nothing
  Set objSh = Nothing
End Sub

cu
Chris

Bild

Betrifft: AW: Code änd. - neues Arbeitsblatt in neuer Datei
von: Wolfango
Geschrieben am: 12.10.2015 16:21:55
....das funktioniert ganz ausgezeichnet!!
Vielen vielen Dank!!!!
Ein paar Zusatzwünsche hätte ich dennoch (erst gesehen, nachdem ich alles getestet habe), falls sich diese mit angemessenem Aufwand in den Code integrieren lassen:
a.) die "neue Datei" mit dem hierhin kopierten Arbeitsblatt soll im Vordergrund erscheinen (liegt leider nach Ablauf des Makros im Hintergrund)
b.) beim Kopieren in die neue Datei sollte idealerweise auch die Zeilenhöhe mitkopiert werden (geschieht nicht)
c.)in der Tabelle der neuen Datei sollen die Zellen C6:I49 keine Hintergrundfarbe mehr haben (ursprünglich grau)
d.) wenn machbar: die neue Datei soll nur dieses eine "kopierte" Arbeitsblatt enthalten
Wie gesagt...Zusatzwünsche falls einigermaßen einfach machbar....Priorität entsprechend der aufgeschriebenen Reihenfolge (a.-d.)
Danke und Gruß,
Wo

Bild

Betrifft: AW: Code änd. - neues Arbeitsblatt in neuer Datei
von: ChrisL
Geschrieben am: 13.10.2015 13:18:15
Hi
So...

Sub formular()
  Dim lngI As Long, WB As Workbook, WS As Worksheet
  Dim objSh As Worksheet, objActive As Worksheet, i As Long
  
  Set objActive = ActiveSheet
  Set WB = Workbooks.Add
  Set objSh = WB.ActiveSheet
  
  On Error GoTo ErrExit
  Application.DisplayAlerts = False
  For Each WS In WB.Worksheets
    If WS.Name <> objSh.Name Then WS.Delete
  Next WS
  Application.DisplayAlerts = True
  Application.ScreenUpdating = False
  
  Do While lngI < 99
    lngI = lngI + 1
      objSh.Name = "Formular " & objActive.Range("I2")
      objActive.Range("A1:K20").Copy
      With objSh.Range("A1")
        .PasteSpecial -4163
        .PasteSpecial -4122
        .PasteSpecial xlPasteColumnWidths
        .Select
      End With
      Exit Do
  Loop
  
  For i = 1 To 20
    objSh.Rows(i).RowHeight = objActive.Rows(i).RowHeight
  Next i
  
  
  objSh.Range("C6:I49").Interior.Pattern = xlNone
  
ErrExit:
  With Application
    .DisplayAlerts = True
    .CutCopyMode = False
    .ScreenUpdating = True
  End With
  
  Set objActive = Nothing
  Set objSh = Nothing
End Sub

cu
Chris

Bild

Betrifft: AW: Code änd. - neues Arbeitsblatt in neuer Datei
von: Wolfango
Geschrieben am: 13.10.2015 14:59:17
...absolut perfekt!!
Dankeschön!!
Gruß, Wo

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Code ändern - neues Arbeitsblatt in neuer Datei"