Microsoft Excel

Herbers Excel/VBA-Archiv

Neue sheets auf basis einer Liste erstellen

Betrifft: Neue sheets auf basis einer Liste erstellen von: andreas e
Geschrieben am: 16.09.2004 11:42:19

Hallo zusammen,

irgendwie bekomme ich es wieder mal nicht gebacken.
Auf Basis der nachstehenden Liste sollen neue sheets erstellt werden.
Das auslesen der neuen sheetnamen habe ich über die Hilfsspalte E realisiert.
Es sollen nun also die neuen sheets in die Mappe kommen. Das rüberkopieren der relevanten Datensätze in die neuen sheets bekomme ich dann (Hoffentlich!!) alleine hin.
Ich bräuchte "nur" den Ansatz, wie die Liste in Spalte e durchlaufen wird und das neue sheet angelegt wird. - Blöd ist für mich, das ja mehrere Zeilen identische Namen enthalten und dafür logischerweise aber nur ein sheet neu reinsoll.

 
 ABCDE
1Relevante SpalteSonstige 1Sonstige 2Sonstige 3Hilfsspalte
213-13-0578Text 1irgendwelche Angabendiese Zeile in  Sheet 13-1313-13
313-13-0580Text 3irgendwelche Angabendiese Zeile in  Sheet 13-1313-13
413-14-0779Text 2irgendwelche Angabendiese Zeile in  Sheet 13-1413-14
513-14-0783Text 6irgendwelche Angabendiese Zeile in  Sheet 13-1413-14
613-15-0681Text 4irgendwelche Angabendiese Zeile in  Sheet 13-1513-15
713-15-0682Text 5irgendwelche Angabendiese Zeile in  Sheet 13-1513-15
Formeln der Tabelle
E2 : =LINKS(A2;5)
E3 : =LINKS(A3;5)
E4 : =LINKS(A4;5)
E5 : =LINKS(A5;5)
E6 : =LINKS(A6;5)
E7 : =LINKS(A7;5)
 
Diagramm - Grafik - Excel Tabellen einfach im Web darstellen    Excel Jeanie HTML  3.0    Download  


Gruß und danke im voraus
andreas e
  


Betrifft: AW: Neue sheets auf basis einer Liste erstellen von: ANdreas
Geschrieben am: 16.09.2004 12:43:55

Hallo Andreas,

hier mal ein Ansatz:

Sub GeneriereSheets()
Dim i&, s$, sh As Worksheet

i = 2

s = Worksheets("Tabelle1").Cells(i, 5).Text
On Error GoTo ErrorHandler
While Not s = ""
    Worksheets(s).Name = s
    i = i + 1
    s = Worksheets("Tabelle1").Cells(i, 5).Text
Wend
On Error GoTo 0
Exit Sub
ErrorHandler:
    Set sh = ActiveWorkbook.Worksheets.Add(After:=Sheets(1))
    sh.Name = s
    Resume Next
End Sub


Hoffe das hilft weiter,
Andreas


  


Betrifft: DANKE!! Passt zu 100% oT von: andreas e
Geschrieben am: 16.09.2004 12:50:55




  


Betrifft: AW: Neue sheets auf basis einer Liste erstellen von: Uduuh
Geschrieben am: 16.09.2004 12:49:20

Hallo Andreas,
ungetestet, sollte aber gehen:
Sub Blaetter_anlegen()
  Dim shListe As Worksheet, shNeu As Worksheet, n As Long
  Set shListe = Sheets("Liste") 'Blatt mit deiner Liste
  For n = 2 To shListe.Range("E65536").End(xlUp).Row
    On Error Resume Next
    Set shNeu = Sheets(shListe.Cells(n, 5).Value)
    On Error GoTo 0
    If shNeu Is Nothing Then
      Set shNeu = Sheets.Add
      shNeu.Name = shListe.Cells(n, 5).Value
    End If
      shListe.Range(Cells(n, 1), Cells(n, 4)).Copy _
        Destination:=shNeu.Cells(65536, 1).End(xlUp).Offset(1, 0)
    Set shNeu = Nothing
  Next n
End Sub

Gruß aus'm Pott
Udo


  


Betrifft: Die methode range für das.... von: andreas e
Geschrieben am: 16.09.2004 13:02:10

objekt worksheet ist fehlgeschlagen....

der code setzt im debugger hier auf:

shListe.Range(Cells(n, 1), Cells(n, 4)).Copy _
Destination:=shNeu.Cells(65536, 1).End(xlUp).Offset(1, 0)

Aber zunächst mal super danke ! Das ist ja schon der nächste schritt inklusive !
Nur was bitte mag er am range nicht ?

Gruß
andreas e


  


Betrifft: AW: Die methode range für das.... von: Uduuh
Geschrieben am: 16.09.2004 13:35:36

Hallo Andreas,
hier eine überarbeitete Version:
Sub Blaetter_anlegen()
  Dim shListe As Worksheet, shNeu As Worksheet, n As Long
  Set shListe = Sheets("Liste") 'Blatt mit deiner Liste
  For n = 2 To shListe.Range("E65536").End(xlUp).Row
    On Error Resume Next
    Set shNeu = Sheets(shListe.Cells(n, 5).Value)
    On Error GoTo 0
    If shNeu Is Nothing Then
      Set shNeu = Sheets.Add(after:=Sheets(Sheets.Count)) 'immer am Ende anfügen
      shNeu.Name = shListe.Cells(n, 5).Value
    End If
    shListe.Activate
    shListe.Range(Cells(n, 1), Cells(n, 4)).Copy _
    Destination:=shNeu.Cells(65536, 1).End(xlUp).Offset(1, 0)
    Set shNeu = Nothing
  Next n
End Sub

Für die Kopieraktion musste shListe das aktive Blatt sein.

Gruß aus'm Pott
Udo


  


Betrifft: 1000 Dank !! Echt genial ... von: andreas e
Geschrieben am: 16.09.2004 13:41:56

hallo Udo,

kompetent, schnell, genau was ich brauche, ...

eben der Udo aus dem Pott !

Danke dir
gruß
andreas e


 

Beiträge aus den Excel-Beispielen zum Thema "Neue sheets auf basis einer Liste erstellen"