kopieren naar specifiek tabblad

[Scripter]

Wie o wie kan mij helpen?

Ik heb een tabblad "totaal" wat elke week ingelezen wordt vanaf een andere locatie. Gaat om +/- 20.000 regels en 20 kolommen.
Vervolgens moet deze data gekopieerd worden naar 40 tabbladen, met als criterea een klantnummer. Dus alle (en alleen) regels van klant1, moeten naar tabblad "klant1" gekopieerd worden, vervolgens alle regels van klant2 naar tabblad "klant2", enz.

Nou had ik hier voorheen formules voor (vlookup) e.d., maar die gaan het niet meer trekken. Krijg ruzie met systeembeperkingen...

Bijgevoegd bestand is een voorbeeld (voor wie denkt wat weinig data te zien).

Kan iemand mij helpen aan de macro die ik hiervoor kan gebruiken (kom er zelf nog niet uit). Vast dank voor de moeite.

Bekijk bijlage testbestand.xls

 

[HSV]

Onderstaande code komt van de hand van Roncancio.

Sub Gegevens()
Dim lRij As Long, R As Variant
Dim sBedrijf As String

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

 

[Scripter]

"WAUW" was mijn eerste reactie toen ik dit teste. Nog steeds trouwens.

Is het mogelijk om mij als (nog steeds...) leek, enigszins in begrijpbaar Nederlands uit te leggen hoe de macro werkt? Ik zie in de macro niets staan waaruit blijkt dat ie weet waar de data heen moet.
In het originele bestand - wat te groot is om te posten - moet ie kopiëren vanaf F5. Ik neem aan dat ik dan het volgende moet vervangen: 1Rij = 2 naar 1Rij = 5, "A" naar "F" en Range("A1:C1") naar Range("F4:AN4").

 

[Scripter]

Aangepast en dat werkt dus goed, alleen maakt ie nu automatisch een tabblad aan met de naam "Klant ID". Waar gaat dit fout?

Sub Gegevens()
Dim lRij As Long, R As Variant
Dim sBedrijf As String

    On Error Resume Next
    lRij = [COLOR="red"]5[/COLOR]
    While Worksheets("Totaal").Range("[COLOR="red"]F[/COLOR]" & lRij).Value <> ""
        sBedrijf = Worksheets("Totaal").Range("[COLOR="red"]F[/COLOR]" & lRij).Value
        
        If Worksheets(sBedrijf) Is Nothing Then
            Worksheets.Add After:=Sheets(Sheets.Count)
            With Worksheets(Worksheets.Count)
                .Name = sBedrijf
                .Range("[COLOR="red"]F4:H4[/COLOR]").Value = Worksheets("Totaal").Range("[COLOR="red"]F4:H4[/COLOR]").Value
            End With
        End If
        
        R = Worksheets(sBedrijf).Range("[COLOR="red"]F[/COLOR]" & Rows.Count).End(xlUp).Row + 1
        Worksheets(sBedrijf).Range("[COLOR="red"]F[/COLOR]" & R & ":H" & R).Value = Worksheets("Totaal").Range("[COLOR="red"]F[/COLOR]" & lRij & ":H" & lRij).Value
        lRij = lRij + 1
        
    Wend
    Worksheets("Totaal").Activate
End Sub

Aangepast... Al doende leert men, dus bij deze
Heb er een stukje uit gehaald en dat schijnt het te zijn. Kom nu op het volgende uit:

Sub Gegevens()
Dim lRij As Long, R As Variant
Dim sBedrijf As String

    On Error Resume Next
    lRij = [COLOR="red"]5[/COLOR]
    While Worksheets("Totaal").Range("[COLOR="red"]F[/COLOR]" & lRij).Value <> ""
        sBedrijf = Worksheets("Totaal").Range("[COLOR="red"]F[/COLOR]" & lRij).Value
        
        R = Worksheets(sBedrijf).Range("[COLOR="red"]F[/COLOR]" & Rows.Count).End(xlUp).Row + 1
        Worksheets(sBedrijf).Range("[COLOR="red"]F[/COLOR]" & R & ":H" & R).Value = Worksheets("Totaal").Range("[COLOR="red"]F[/COLOR]" & lRij & ":H" & lRij).Value
        lRij = lRij + 1
        
    Wend
    Worksheets("Totaal").Activate
End Sub

Snap nu ook hoe die werkt, maar nog wel de vraag (worden er steeds minder op deze manier...) waarom die bij Range &":H"&R heeft staan. "F"&R snap ik, dat is de cel locatie, maar waar komt die ":H" vandaan / wat doet dit?

 

[HSV]

Snap nu ook hoe die werkt, maar nog wel de vraag (worden er steeds minder op deze manier...) waarom die bij Range &":H"&R heeft staan. "F"&R snap ik, dat is de cel locatie, maar waar komt die ":H" vandaan / wat doet dit?

Als je het ene begrijpt, begrijp ik niet dat je het andere dan niet begrijpt.

Overigens maakt je vernieuwde code geen nieuwe klant-tabbladen meer aan.

 

[Warme bakkertje]

Misschien is deze makkelijker te begrijpen.

Sub tst()
With Sheets("totaal")
    For Each cl In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        Sheets(cl.Value).[A65536].End(xlUp).Offset(1).Resize(, 3) = _
                    .Cells(cl.Row, 1).Resize(, 3).Value
    Next
End With
End Sub

 

[Scripter]

@HSW

Als je het ene begrijpt, begrijp ik niet dat je het andere dan niet begrijpt.

Ik dacht nog dat dit gewoon kolom H was/is, maar waarom staat er dan een : voor?

@Warme Bakkertje

Misschien is deze makkelijker te begrijpen.

Te begrijpen nog net, maar voor mij niet makkelijker... :d

Hoe dan ook, hier kom ik wel mee weg. Beiden bedankt voor de medewerking!

 

[HSV]

@HSW
Ik dacht nog dat dit gewoon kolom H was/is, maar waarom staat er dan een : voor?

Met

.Range("F" & R & ":H" & R)

wordt een range aangeduid, net als
=Som(F4:H4), dus kolom G doet ook mee.

Met de R wordt een variabel rij aangeduid.

 

[Scripter]

Blijk ik dus toch minder intelligent te zijn als ik dacht :d
Had deze niet aan zien komen