Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1424to1428
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

automatisiert Kopien des Arbeitsblattes anlegen

automatisiert Kopien des Arbeitsblattes anlegen
22.05.2015 16:09:15
Wolfango
Hallo zusammen,
Ich suche ein Makro welches folgendes macht:
Ein neues Arbeitsblatt soll angelegt werden mit dem Namen "Formular 01".
Anschließend soll der Zellbereich A1:K20 des aktuellen Arbeitsblattes in dieses Formular 01 kopiert werden.
Das Ganze soll wiederholbar sein, d.h. beim nächsten Aufruf des Makros soll das Formular "Formular 02" heißen usw. (jeweils wieder mit dem Inhalt aus A1:K20)
Ist das irgendwie machbar?
Danke und Gruß,
Wo

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: automatisiert Kopien des Arbeitsblattes anlegen
25.05.2015 11:36:04
Sepp
Hallo Wolfgang,
Sub formular()
  Dim lngI As Long
  Dim objSh As Worksheet, objActive As Worksheet
  Set objActive = ActiveSheet
  
  Do While lngI < 99
    lngI = lngI + 1
    If Not SheetExist("Formular " & Format(lngI, "00")) Then
      Set objSh = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
      objSh.Name = "Formular " & Format(lngI, "00")
      objSh.Range("A1:K20") = objActive.Range("A1:K20").Value
      objActive.Activate
      Exit Do
    End If
  Loop
  
  Set objActive = Nothing
  Set objSh = Nothing
End Sub


Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function


Gruß Sepp

Anzeige
AW: automatisiert Kopien des Arbeitsblattes anlegen
27.05.2015 16:50:23
Wolfango
Vielen Dank!
Das funktioniert schon mal super!
Lässt sich der Code so abändern, dass der kopierte Bereich (A1:K20) mit seinem Ursprungsformat eingefügt wird? (...sorry, ich war in diesem Punkt nicht präzise)
Gruß, Wo

AW: automatisiert Kopien des Arbeitsblattes anlegen
27.05.2015 19:40:43
Sepp
Hallo Wolfgang,
klar, kein Problem.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

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 " & Format(lngI, "00")) Then
      Set objSh = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
      objSh.Name = "Formular " & Format(lngI, "00")
      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



Private Function SheetExist(ByVal sheetName As String, Optional Wb As Workbook) As Boolean
  Dim wks As Worksheet
  On Error GoTo ERRORHANDLER
  If Wb Is Nothing Then Set Wb = ThisWorkbook
  For Each wks In Wb.Worksheets
    If LCase(wks.Name) = LCase(sheetName) Then SheetExist = True: Exit Function
  Next
  ERRORHANDLER:
  SheetExist = False
End Function


Gruß Sepp

Anzeige
AW: automatisiert Kopien des Arbeitsblattes anlegen
28.05.2015 09:57:31
Wolfango
Absolut Perfekt!
Das hilft mir sehr weiter!
Vielen Dank!!!!!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige