Microsoft Excel

Herbers Excel/VBA-Archiv

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

kopieren eines großen Tabellenblatts nicht möglich | Herbers Excel-Forum


Betrifft: kopieren eines großen Tabellenblatts nicht möglich von: Bibabutzel
Geschrieben am: 15.01.2010 22:18:02

Hallo zusammen,

der nette Sepp (Josef Ehrensberger) aus diesem Forum hat mir ein Makro geschrieben, das nach Erfüllung verschiedener Bedingungen mehrere neue Tabellenblätter erzeugt, indem ein "Vorlage-Tabellenblatt" kopiert wird. Das Makro funktioniert tadellos - allerdings nur, wenn das "Vorlage-Tabellenblatt" leer oder (wie ich vermute) sehr klein ist (da sind dann 20 neue Tabellenblätter auf einmal kein Problem). Nun ist das Vorlage-Tabelleblatt im meinem Fall allerdings ziemlich groß (ein Haufen Diagramme sowie eine große und eine kleinere Tabelle) und nach etwa 10 bis 11 neu angelegten Blättern ist Schluss. Ich habe dann mal versucht, diese Vorlage von "Hand" zu vervielfältigen (sowohl über den Befehl kopieren/ verschieben im Kontextmenü, als auch über Strg+C und Strg+V in der rechten oberen Ecke), aber auch da ist nach 10 bis 11 mal Feierabend.

Da das (mehrfache) "auf-einmal-kopieren" meiner Vorlage weder mit dem Makro noch manuell funktioniert, wollte ich mal in die Runde fragen, ob jemand eine Idee hat, woran das liegen kann.

Im voraus schon vielen Dank für alle Meldungen, Tipps und Anregungen!

Liebe Grüsse
Bibabutzel

  

Betrifft: Welche Fehlermeldung erscheint denn ? _oT von: NoNet
Geschrieben am: 15.01.2010 23:04:46

_oT = "ohne Text"


  

Betrifft: AW: Welche Fehlermeldung erscheint denn ? _oT von: Bibabutzel
Geschrieben am: 15.01.2010 23:09:23

Hallo NoNet,

es erscheint keine FM. Das letzte kopierte Tabellenblatt (also das 10. oder 11.) ist unvollständig (Diagramme fehlen, Formatierungen stimmen nicht) und danach passiert gar nix mehr. Eine Idee, woran es liegen könnte?

LG
Bibabutzel


  

Betrifft: Schau auf xlam.ch nach,... von: Luc:-?
Geschrieben am: 15.01.2010 23:07:21

...Butzel,
da könnte/sollte auch dazu was stehen. Ansonsten, was hindert dich daran, zwischendurch noch mal neu zu kopieren und damit dann die nächsten 10 Blätter zu erzeugen...?
Gruß Luc :-?


  

Betrifft: AW: Schau auf xlam.ch nach,... von: Bibabutzel
Geschrieben am: 15.01.2010 23:13:43

Hi Luc:-?

Danke für den Link, ich schau mir das mal an. Deinen anderen Tipp habe ich ja (verzweifelt) versucht, funktioniert aber eben nicht (siehe Antwortauf NoNet seinen Beitrag).

LG
Bibabutzel


  

Betrifft: AW: kopieren eines großen Tabellenblatts nicht möglich von: Bibabutzel
Geschrieben am: 15.01.2010 23:45:03

Hallo

ich habe mir jetzt eine Notlösung überlegt: Ich erzeuge mir einen (übergroßen) "Vorrat" an den benötigten Tabellenblättern, blende sie aus und benenne sie aufsteigend nach Zahlen (also 1, 2, 3, etc.).

Ist es möglich, das Makro von Sepp (siehe unten) so umzuschreiben, dass nach der Prüfung nicht ein neues Tabellenblatt erzeugt wird, sondern dass das (nun schon bestehende) Tabellenblatt mit der kleinsten Zahl einfach nur umbenannt wird (und den Namen bekommt, der in Blatt2 nicht vorhanden war)?

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim objSh As Worksheet, rng As Range
  Dim vntRet As Variant
  
  On Error GoTo ErrExit
  
  If Target.Column = 1 Then
    For Each rng In Intersect(Target, Columns(1))
      If rng <> "" Then
        Select Case rng.Row
          Case 10 To 34, 40 To 64, 70 To 94 'hier die Blöcke (Zeilen) angeben!
            vntRet = Application.Match(rng.Value, Sheets("Blatt2").Range("A20:A" & _
              Application.Max(20, Sheets("Blatt2").Cells(Rows.Count, 1).End(xlUp).Row)), 0)
            If Not IsNumeric(vntRet) Then
              Application.ScreenUpdating = False
              Sheets("Blatt2").Range("A" & Application.Max(20, Sheets("Blatt2").Cells(Rows. _
Count, _
                1).End(xlUp).Row + 1)) = rng.Value
              If Not SheetExist(rng.Value) Then
                Sheets("Blatt3").Copy After:=Sheets(Sheets.Count)
                Sheets(Sheets.Count).Name = rng.Value
                Me.Activate
              End If
            End If
          Case Else
        End Select
      End If
    Next
  End If
  
ErrExit:
  Application.ScreenUpdating = True
  Set objSh = Nothing
  Set rng = 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 wks.Name = sheetName Then SheetExist = True: Exit Function
  Next
ERRORHANDLER:
  SheetExist = False
End Function
Danke für Eure Hilfe!


  

Betrifft: AW: kopieren eines großen Tabellenblatts nicht möglich von: fcs
Geschrieben am: 16.01.2010 04:46:06

Hallo Bibabutzel,

mit den folgenden ANpassungen und Ergänzungen werden Blätter mit Nummern >h0 umbenannt.


Evlt. reicht es aber auch wenn du in deiner vorhandenen Prozedur nach jedem Kopieren eines Blattes die Datei speicherst. Excel setzt beim Speichern verschiedene Zähler zurück, evtl auch den, der in deiner Datei beim 10. Blatt zum überlauf führt.

gruß
Franz

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim objSh As Worksheet, rng As Range, strMin As String
  Dim vntRet As Variant
  
  On Error GoTo ErrExit
  
  If Target.Column = 1 Then
    For Each rng In Intersect(Target, Columns(1))
      If rng <> "" Then
        Select Case rng.Row
          Case 10 To 34, 40 To 64, 70 To 94 'hier die Blöcke (Zeilen) angeben!
            vntRet = Application.Match(rng.Value, Sheets("Blatt2").Range("A20:A" & _
              Application.Max(20, Sheets("Blatt2").Cells(Rows.Count, 1).End(xlUp).Row)), 0)
            If Not IsNumeric(vntRet) Then
              Application.ScreenUpdating = False
              Sheets("Blatt2").Range("A" & Application.Max(20, _
                Sheets("Blatt2").Cells(Rows.Count, 1).End(xlUp).Row + 1)) = rng.Value
              If Not SheetExist(rng.Value) Then
                strMin = SheetMinNummer
                If strMin = "0" Then
                  MsgBox "Keine Blätter mehr zum Umbenennen vorhanden!"
                  Exit Sub
                Else
                  Sheets(strMin).Name = rng.Value
                  Me.Activate
'                  ThisWorkbook.Save
                End If
              End If
            End If
          Case Else
        End Select
      End If
    Next
  End If
  
ErrExit:
  Application.ScreenUpdating = True
  Set objSh = Nothing
  Set rng = 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 wks.Name = sheetName Then SheetExist = True: Exit Function
  Next
ERRORHANDLER:
  SheetExist = False
End Function

Function SheetMinNummer() As String
  Dim wks As Worksheet, MinNummer As Long
  MinNummer = 0
  For Each wks In ThisWorkbook.Worksheets
    If Val(wks.Name) > 0 Then
          If MinNummer = 0 Then
            MinNummer = Val(wks.Name)
          ElseIf Val(wks.Name) < MinNummer Then
            MinNummer = Val(wks.Name)
          End If
    End If
  Next
  SheetMinNummer = Format(MinNummer, "0")
End Function



  

Betrifft: AW: kopieren eines großen Tabellenblatts nicht möglich von: Bibabutzel
Geschrieben am: 16.01.2010 11:53:29

Hallo fcs,

vielen Dank für die Anpassung des Makros. So klappt es.
Warum das mit dem Kopieren allerdings nicht funktioniert, weiß ich jetzt immer noch nicht (auch das Speichern nach jedem neu erzeugten Blatt klappte leider nicht - da war dann schon nach dem dem dritten neuen Blatt "Sense"). Ist doch schon komisch, oder?

LG
Bibabutzel


Beiträge aus den Excel-Beispielen zum Thema "kopieren eines großen Tabellenblatts nicht möglich"