kop blad1 meenemen bij automatisch aanmaken van tabladen

[Blommo]

Hallo Allen,

Via de site heb ik uitgevonden hoe ik tabbladen automatisch kan genereren.
Kan ik dit ook zo laten plaatsvinden dat op ieder tabblad de kop van blad 1 wordt geplaatst.
In de bijlage blad 1 toegevoegd als voorbeeld (blad1 wil ik niet in bestand opnemen)
Macro start met Ctrl Q

M.v.g. Blommo

 

[nire]

Wat dacht je van deze code:

Sub Test1()
Dim sWB As String
Dim ws As Worksheet
Dim lRij As Long
    sWB = ActiveSheet.Name
    lRij = 2
    While Worksheets(sWB).Range("A" & lRij).Value <> ""

        On Error Resume Next
        If Worksheets(Worksheets(sWB).Range("A" & lRij)).Value Is Nothing Then
            Set ws = ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count))
            
            ws.Range("A1", "A1") = "Kop1"
            ws.Range("B1", "B1") = "Kop2"
            ws.Name = Worksheets(sWB).Range("A" & lRij).Value
        End If
        lRij = lRij + 1
    Wend
End Sub

 

[Blommo]

Hoi Nire,

Bedankt voor je reactie
Op zich is dat wel wat ik bedoel, maar heb toch nog een vervolg op mijn vraag:
Is het ook mogelijk om kolombreedtes aan te geven cq. te verbergen evt. deze rij in te kleuren.

Groet Blommo

 

[nire]

Sub Test1()
Dim sWB As String
Dim ws As Worksheet
Dim lRij As Long

    sWB = ActiveSheet.Name
    lRij = 2
    While Worksheets(sWB).Range("A" & lRij).Value <> ""

        On Error Resume Next
        If Worksheets(Worksheets(sWB).Range("A" & lRij)).Value Is Nothing Then
            Set ws = ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count))
            
            ws.Range("A1", "A1") = "Kop1"
            ws.Range("B1", "B1") = "Kop2"
            ws.Range("A1", "B1").Interior.Color = RGB(128, 128, 128)
            ws.Columns("A").ColumnWidth = 120
            ws.Name = Worksheets(sWB).Range("A" & lRij).Value
        End If
        lRij = lRij + 1
    Wend
End Sub

oh ja, en een kolom verbergen doe je dan met:

ws.Columns("B").Hidden = True

 

[Blommo]

Hoi Nire,

Helemaal geweldig, werkt als een speer.
Maar ja nu ik bezig ben, kan ik de tekst ook "terugloop" onder elkaar plaatsen?

Waar kan ik die kleurnummers te voorschijn toveren 128 is nogal donker

Groet Blommo

 

[nire]

ws.Range("A1", "A1").WrapText = True

Hier kun je wat kleuren bekijken/kiezen en de RGB bekijken.

http://www.colorschemer.com/online.html

Hoe hoger, hoe lichter, dus 200, 200, 200 zal een lichtere grijze kleur geven.

 

[Blommo]

Hoi Nire,

Werkt fantastisch,

Waar kan ik de de teksten tevoorschijn toveren als wraptekst?

bijv. om de tekst ook nog te centreren, en evt kader eromheen te plaatsen

Groet Blommo:

 

[nire]

ws.Range("A1", "A1").HorizontalAlignment = xlCenter

of:
xlDistributed
xlJustify
xlLeft
xlRight

Kader doe je met:
ws.Range("A1", "A1").Borders.Weight = 2

2 is dan de dikte van je border

 

[Blommo]

Hoi Nire,

Hartstikke bedankt voor je hulp, kunt er leuke dingen mee maken.
In de bijlage nog een voorbeeld zoals het is geworden
Als het goed is Ctrl Q en de tabladen komen tevoorschijn met het juiste kopkader

Groet Blommo

 

[nire]

:thumb: