kopieren opmaak naar nieuwe tabbladen

[resmatrix]

Beste Allemaal,

Middels dit forum heb ik een prima programma gevonden welke met VBA de brondata kopieert naar verschillende tabbladen.

Nu heb ik 1 vraag. Heeft iemand voor mij een code waarmee niet alleen de waarden kopieert maar ook het format waarmee ze in het bronbestand staan. (kleur, % etc) Ik heb al vanalles geprobeert maar het wil me deze keer echt niet lukken als iemand kan helpen heeeeeel graag

Het bestand heb ik als bijlage toegevoegd

vast bedankt voor de moeite

 

[resmatrix]

Wellicht ten overvloedde en zeker niet juist dacht ik dat eea op te lossen was met:
with
.Format ("A1:H1").Value = Worksheets("Bron").Range("A1:H1").Value

Maar dat werkt niet zoals ik gehoopt had

 

[Warme bakkertje]

Sub Gegevens()
Dim lRij As Long
Dim sBedrijf As String

    On Error Resume Next
    lRij = 2
    While Worksheets("Bron").Range("A" & lRij).Value <> ""
        sBedrijf = Worksheets("bron").Range("B" & lRij).Value
        
        If Worksheets(sBedrijf) Is Nothing Then
            Worksheets.Add After:=Sheets(Sheets.Count)
            With Worksheets(Worksheets.Count)
                .Name = sBedrijf
                .Range("A1:H1").Value = Worksheets("Bron").Range("A1:H1").Value
            End With
        End If
        
        R = Worksheets(sBedrijf).Range("A" & Rows.Count).End(xlUp).Row + 1
        Worksheets("Bron").Range("A" & lRij & ":H" & lRij).Copy Worksheets(sBedrijf).Range("A" & R & ":H" & R)
        lRij = lRij + 1
        
    Wend
    Worksheets("Bron").Activate
End Sub

 

[resmatrix]

Dank dat is inderdaad wat ik bedoel.

Ik heb alleen nog 1 maar de kleuren in rij 1 dienen als kop op ieder tabblad terug te komen. kand dat ook?

sry voor de vele vragen

 

[Warme bakkertje]

Daarvoor zijn we hier, nietwaar
Wijzig deze

.Range("A1:H1").Value = Worksheets("Bron").Range("A1:H1").Value

in deze

Worksheets("Bron").Range("A1:H1").Copy .Range("A1:H1")

 

[resmatrix]

PERFECT hartelijk dan