meerdere sheets genereren uit sheet met persoonsgegevens

[Ericssport]

Hey!

Ik ben nieuw hier, maar heb wel al regelmatig gebruik gemaakt van dit forum, mijn dank daarvoor!

Ik probeer uit uit een sheet met persoonsgegevens voor elke persoon een nieuwe sheet aan te maken, heb al vanalles geprobeerd en het halve internet afgezocht maar tot mijn spijt niet verder gekomen, wie kan me helpen?!

Voorbeeld:

Voornaam Achternaam Postcode Plaats
Jan Janssen 5874 AB Utrecht
Piet Pietersen 5464 DC Amsterdam
Klaas Klaassen 8483 ER Rotterdam

Dit zouden dan drie nieuwe sheets moeten worden.

bvd

 

[Roncancio]

Onderstaande macro maakt nieuwe werkbladen aan (voor zover ze nog niet zijn aangemaakt) van de namen in de A-kolom van het huidige werkblad. (vanaf regel 2).

Sub Werkblad()
Dim sWB As String
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
            ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = Worksheets(sWB).Range("A" & lRij).Value
        End If
        lRij = lRij + 1
    Wend
End Sub

Met vriendelijke groet,


Roncancio

 

[Ericssport]

Geweldig bedankt Roncancio !!

Dit heeft me geweldig geholpen. Eén klein puntje, met deze macro kan ik nu de tabbladen aanmaken, alleen hij neemt niet de gegevens van de moedersheet mee naar die tabbladen. Kan iemand mij daar bij helpen?! Hieronder het moedersheet (1) en hoe het eruit zou moeten komen zien (2).

 

[Roncancio]

Bij deze.

Sub Test1()
Dim sWB As String
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
            ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count)
            Worksheets(Worksheets.Count).Name = Worksheets(sWB).Range("A" & lRij).Value
            With Worksheets(Worksheets.Count)
                .Range("A1").Value = Worksheets(sWB).Range("A" & lRij).Value
                .Range("B1").Value = Worksheets(sWB).Range("B" & lRij).Value
                .Range("A2").Value = Worksheets(sWB).Range("C" & lRij).Value
                .Range("A3").Value = Worksheets(sWB).Range("D" & lRij).Value
                .Range("B3").Value = Worksheets(sWB).Range("E" & lRij).Value
                .Range("A5").Value = Worksheets(sWB).Range("F" & lRij).Value

            End With
        End If
        lRij = lRij + 1
    Wend
End Sub

Met vriendelijke groet,


Roncancio

 

[Ericssport]

Tjemig Roncancio, wat goed en snel!

Ik heb nog één klein vraagje, de sheets die de macro aanmaakt zouden eigenlijk formulieren moeten zijn met de persoonsgegevens daarin (of wellicht maak je die formulieren aan tegelijkertijd met de sheets?) Ik heb het formulier bijgevoegd, gevens zouden dan in B1 t/m 6. Is dat mogelijk?

 

[robrobbes]

copy-paste

Voorbeeld:
'selecteer bron-sheet
Sheets("bronsheet").Select
'selecteer bron cel of range van cellen
Range("A1").Select

'we willen niet knippen, maar kopieren
Application.CutCopyMode = False
Selection.Copy

'selecteer doelsheet
Sheets("doelsheet").Select
'selecteer target cel of range van cellen
Range("A1").Select

'plakken
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Groet,
Rob
www.excelhet.nl

 

[Finch]

Voorbeeld:
'selecteer bron-sheet
Sheets("bronsheet").Select
'selecteer bron cel of range van cellen
Range("A1").Select

'we willen niet knippen, maar kopieren
Application.CutCopyMode = False
Selection.Copy

'selecteer doelsheet
Sheets("doelsheet").Select
'selecteer target cel of range van cellen
Range("A1").Select

'plakken
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Groet,
Rob
www.excelhet.nl

al je .select toevoegingen zijn feitelijk te vermijden. Je hebt ze ook niet nodig om het werkend te krijgen.

 

[Ericssport]

Mijn dank is groot!