neues Blatt mit Beschriftung

Forumthread: neues Blatt mit Beschriftung

04.08.2004 16:06:54

Christina

Hallo Excel-Experten,
Ich habe folgendes Problem:
Ich habe ein Arbeitsblatt mit sich wiederholenden Daten in einer Spalte, d.h. eine unbekannte Anzahl von Zahlen wiederholt sich in Spalte C immer wieder (z.B. 33,65,129,109,33,65,129,109 usw.). Ich möchte jetzt für jede neue Zahl automatisch ein eigenes Arbeitsblatt, welches möglichst die Zahl zum Namen hat. In dieses Blatt sollen dann die der Zahl zugehörigen Reihen übertragen werden.
Hat irgendjemand eine Idee, wie sich das Ganze automatisieren lässt?
Grüße,
Christina

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: neues Blatt mit Beschriftung

04.08.2004 16:26:22

Nepumuk
AW: neues Blatt mit Beschriftung

04.08.2004 16:48:52

Christina
AW: neues Blatt mit Beschriftung

04.08.2004 16:54:19

Nepumuk
AW: neues Blatt mit Beschriftung

Christina

AW: neues Blatt mit Beschriftung

04.08.2004 16:26:22

Nepumuk

Hallo Christina,
versuch es mal so:

Public Sub Christina()
    Dim lngZeile As Long, myWorksheet As Worksheet, bolgefunden As Boolean, mySheet As Worksheet
    Set mySheet = ActiveSheet
    For lngZeile = 1 To Cells(Rows.Count, 3).End(xlUp).Row
        If Trim(mySheet.Cells(lngZeile, 3)) <> "" And IsNumeric(mySheet.Cells(lngZeile, 3)) Then
            bolgefunden = False
            For Each myWorksheet In Worksheets
                If myWorksheet.Name = mySheet.Cells(lngZeile, 3) Then bolgefunden = True: Exit For
            Next
            If Not bolgefunden Then
                Worksheets.Add After:=Worksheets(Worksheets.Count)
                Worksheets(Worksheets.Count).Name = mySheet.Cells(lngZeile, 3)
            End If
            With Worksheets(CStr(mySheet.Cells(lngZeile, 3)))
                If .Cells(1, 3) = "" Then
                    .Rows(1) = mySheet.Rows(lngZeile).Value
                Else
                    .Rows(.Cells(Rows.Count, 3).End(xlUp).Row + 1) = mySheet.Rows(lngZeile).Value
                End If
            End With
        End If
    Next
    Set mySheet = Nothing
End Sub

Gruß
Nepumuk

AW: neues Blatt mit Beschriftung

04.08.2004 16:48:52

Christina

Hi Nepumuk,
das ging aber schnell! Danke, das Makro klappt super. Du hast mir eine Menge Arbeit erspart...
Eine Frage noch:
In einer Spalte steht ein Datum [TT.MM.JJJJ hh:mm], welches nach dem Kopieren in das neue Blatt auf einmal in der oberen Hälfte der Tabelle (zumindest ca.) in amerikanischem Format [MM/TT/JJJJ h:mm AM/PM] erscheint. Das Format lässt sich auch nicht mit "Zellen formatieren..." ändern.
Hast du eine Idee, was da falsch läuft?
Gruß,
Christina

AW: neues Blatt mit Beschriftung

04.08.2004 16:54:19

Nepumuk

Hallo Christina,
dann müssen wir kopieren. Ändere die Zeile:
.Rows(1) = mySheet.Rows(lngZeile).Value
so:
mySheet.Rows(lngZeile).Copy .Rows(1)
und die Zeile:
.Rows(.Cells(Rows.Count, 3).End(xlUp).Row + 1) = mySheet.Rows(lngZeile).Value
so:
mySheet.Rows(lngZeile).Copy .Rows(.Cells(Rows.Count, 3).End(xlUp).Row + 1)
Gruß
Nepumuk

AW: neues Blatt mit Beschriftung

Christina

Merci Nepumuk,
jetzt funktioniert das Makro super!
Gruß
Christina

Beliebteste Forumthreads (12 Monate)

Forumthread: neues Blatt mit Beschriftung

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread