title image


Smiley Korrektur: Zellen inkl. Formatierung übertragen
Hey mromar,



um nicht nur den Inhalt sondern auch die Formatierung der Zellen zu übertragen müssen nur 2 Zeilen geändert werden. Hier der vollständige Code :

      

Sub TabNamen()

    On Error Resume Next

    Set blatt = ActiveSheet

    For zeile = 1 To Cells(Rows.Count, 1).End(xlUp).Row

        If blatt.Cells(zeile, 1).Value <> "" Then

            Err.Clear

            Set Blattneu = Sheets(blatt.Cells(zeile, 1).Value)

            If Err <> 0 Then

                Set Blattneu = Sheets.Add(after:=Sheets(Sheets.Count))

                Blattneu.Name = blatt.Cells(zeile, 1)

                zneu = 1

            Else

                zneu = Blattneu.Cells(Rows.Count, 1).End(xlUp).Row + 1

            End If

            'Die nächsten 2 Zeilen übertragen die Zellen inkl. Formatierung :

            blatt.Cells(zeile, 1).Copy Blattneu.Cells(zneu, 1)

            blatt.Cells(zeile, 2).Copy Blattneu.Cells(zneu, 2)

        End If

    Next

End Sub 

Grüße, NoNet

  1,2,3 - kleine Excelei :   Infos + Anmeldung zum Jährlichen Exceltreffen



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: