kopieer rij op basis van variable cell

[Iceje]

Hallo,

Ik probeer de rijen van variabele waarde's in een kolom te kopieren naar een ander blad.
In onderstaand voorbeeld: ik wil de rijen "auto" en "auto totaal" naar sheet2 en de rijen "fiets" en "fiets totaal" naar sheet3 overbrengen, De nieuwe sheets dienen danweer de naam van het product te krijgen. ( in het voorbeeld de uiteindelijke bedoeling, ik begin met alleen Sheet1)
Het probleem zit hem erin dat de producten nooit hetzelfde zijn, dit kan dus niet als vaste waarde in de macro worden gezet. De opmaak van kolom A is wel altijd hetzelfde (alle product type's onder elkaar en eindigt met totaal. dit product komt dan verder niet meer voor in deze kolom.

Ik heb ondertussen heel het internet afgestruind maar vindt alleen maar oplossingen die een vaste waarde gebruiken om de rij te vinden. Dat kan hier dus niet.
Ik heb verschillende van die code's gebruikt met de intentie om in een andere sheet formule "=A1" als de te zoeken range te gebruiken. Wanneer de rij dan gekopieerd zou zijn, deze dan te verwijderen (Sheet1 heb ik na het kopieren niet meer nodig). Probleem hierin is weer... als je dan rij 1 verwijdert, geeft de formule "=A1" de #ref error.

Ik kom hier echt niet uit.. help mij aub.

 

[Cobbe]

Test deze eens:

Sub cobbe()
Dim cl As Range
On Error Resume Next
For Each cl In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
 Set pl = cl.Find(" ")
  If Not pl Is Nothing Then
    sh = Left(cl, pl - 1)
     ElseIf pl Is Nothing Then sh = cl
  End If
 With Sheets(sh)
   r = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    Cells(cl.Row, 1).Resize(, 2).Copy .Cells(r, 1)
 End With
cl.Resize(, 2).ClearContents
Next
End Sub

 

[VenA]

Als je ervoor zorgt dat er geen onnodige spaties achter totaal staan dan kan je deze proberen.

Sub VenA()
With Sheet1
    .[E1] = "product"
    Ar = .Cells(1).CurrentRegion
    For j = 2 To UBound(Ar)
        If LCase(Right(Ar(j, 1), 6)) = "totaal" Then c00 = c00 & "|" & Left(Ar(j, 1), Len(Ar(j, 1)) - 7)
    Next j
    For j = 1 To UBound(Split(c00, "|"))
        Sheets.Add(, Sheets(Sheets.Count)).Name = Split(c00, "|")(j)
        .[e2] = "*" & Split(c00, "|")(j) & "*"
        .[A1].CurrentRegion.AdvancedFilter 2, .[E1:E2], Sheets(Split(c00, "|")(j)).[a1]
    Next j
    .Cells.Clear
End With
End Sub

 

[Iceje]

Bedankt voor jullie antwoorden!!

Allebei werken ze zodat ik al een heel stap dichterbij ben! Echter heb ik een combinatie van die 2 nodig
VenA maakt de nieuwe sheets aan gebaseerd op de cel "product", dat heb ik zowieso nodig. Dan de producten in de juiste sheets. Daarnaast zijn er rond de 15 kolommen nodig die meegekopieerd moeten worden. Dit heb ik zelf kunnen aanpassen in de code van Cobbe. Na veel proberen lukt het toch net niet.

Als de code van Cobbe de mappen aan kan maken zoals VenA OF als VenA meerdere kolommen kan kopieren dan ben ik er.

Daarna moeten de producten nog in een specifiek format staan binnen hun eigen sheet, maar dat ga ik zelf weer proberen, anders leer ik het nooit

 

[Ginger]

Even een vraagje... Kan je niet veel beter gebruik gaan maken van draaitabel en je brongegevens daarmee mooi bij elkaar houden?

 

[gast0660]

Of mischien zoiets?

 

[VenA]

Als de kolommen aaneengesloten zijn dan worden ze met de code uit #3 toch meegekopieerd? Wel nog even een kleine aanpassing

.[[COLOR="#FF0000"]A1[/COLOR]].CurrentRegion.AdvancedFilter

 

[Iceje]

Ginger: Daar had ik ook aan gedacht inderdaad. Maar daarin krijg je een Sum of Product of Top 10 en dergelijke van de aantallen.

Misschien dat ik toch beter alles kan uitleggen wat nu de volledige bedoeling is van mijn project:
Het gaat in werkelijkheid om klanten en hun inkoop bedragen plus veel meer info van een 30-tal producten. Die masterfile bevat heel veel informatie die ik niet nodig heb.
Nu moeten die klanten ieder apart een werkboek ontvangen met de voor hun relevante informatie (Goes without saying, dat het natuurlijk uitermate belangrijk is dat ze niet van een ander de cijfers zien!).

Ook zijn de klantnamen niet iedere maand gelijk, er zijn erbij die die maand niks hebben gekocht, er kunnen nieuwe klanten bijkomen. Ook deze zijn hierdoor niet als vaste waarde te gebruiken.

Ik vind het zelf altijd hele mooie uitdagingen enbegin VBA steeds meer te begrijpen (ben nog altijd een noob hoor). Vanuit google en gevonden code's kan ik daarvan bits and pieces gebruiken en zelf aanpassen om het doel te bereiken, dit is bij aardig wat projecten gelukt zonder iets te vragen. Ik deel het altijd op in gedeelte's. Nu bv eerst het correct filteren en aanpassen van de masterfile. Dan het kopieren vanklantgegevens (wat dus niet lukt), daarna de gewenste volgorde van de product groep en de rest van de gewenste format (dat gaat wel lukken denk ik). Het opslaan van de klantfile's in de juiste mappen is ook geen probleem.

Vanuit het voorbeeld hieronder, er zijn uiteindelijk vanuit de masterfile 15 kolommen te kopieren naar de uiteindelijke klantfile

 

[Iceje]

@VenA

Tot aan kolom D wordt inderdaad meegenomen, verder helaas niet. Het lukt me niet om dit aan te passen.
Waar moet ik die wijzing bij zetten?

@gast0660

Dat is zeker een goede variant! maar als ik ieder product code moet invullen duurt het process erg lang (zijn er nogal wat).


Ik waardeer het zeer dat jullie mij zo helpen!!!!!:thumb:

 

[VenA]

Zorg er eerst voor dat de lege cellen weer aangevuld worden en plaats een voorbeeldje met hoe het echt in elkaar steekt.

Sub VenA()
With Blad1.[j3].CurrentRegion
ar = .Value
    For j = 1 To UBound(ar)
        If ar(j, 1) = "" Then ar(j, 1) = ar(j - 1, 1)
    Next j
    .Value = ar
End With
End Sub

 

[HSV]

Waarschijnlijk zal een en ander aangepast moeten worden in de code doordat je meerdere kolommen hebt.

Hier plaatst @VenA het in cel E2.

 .[e2] = "*" & Split(c00, "|")(j) & "*"

Verander e2 eens in t2.

 

[Iceje]

Yessss, die aanpassing zocht ik nog idd. Ik heb nog 3 andere regels aangepast in de code van VenA en nu werkt het. THANKS

@VenA

Bedankt voor deze geweldig code!!! Ik heb er nu onderstaande van weten te maken.
Ik had in bericht #8 een goed voorbeeld gegeven. Als je nog suggesties hebt zijn ze altijd welkom!

Ik ga weer verder vogelen met de rest! THANKS

Sub VenA()
With Sheet1
    .[T1] = "product"
    ar = .Cells(1).CurrentRegion
    For j = 2 To UBound(ar)
        If LCase(Right(ar(j, 1), 6)) = "totaal" Then c00 = c00 & "|" & Left(ar(j, 1), Len(ar(j, 1)) - 7)
    Next j
    For j = 1 To UBound(Split(c00, "|"))
        Sheets.Add(, Sheets(Sheets.Count)).Name = Split(c00, "|")(j)
        .[T2] = "*" & Split(c00, "|")(j) & "*"
        .[A2].CurrentRegion.AdvancedFilter 2, .[T1:T2], Sheets(Split(c00, "|")(j)).[a1]
    Next j
    
End With
End Sub

 

[VenA]

Succes met vogelen:d

 

[Iceje]

Hoi VenA, en anderen

Ben weer een heel eind opgeschoten gelukkig, maar helaas heb ik toch nog een issue met bovenstaande code. Hij werkt perfect hoor, daar niet van. Probleem is echter dat nu blijkt dat in kolom A bepaalde klanten 2x voorkomen met andere cijfers.
Deze worden in het tabblad met die naam ook allemaal weergegeven. Maar wanneer de macro bij de 2e string van dezelfde klant aankomt, geeft ie natuurlijk de melding dat deze sheet naam al bestaat.
Is er een mogelijkheid dat de eerste string in een tabblad komt (dus zonder de 2e erebij). Als er dan een 2e string komt dat deze dan wel een sheet krijgt maar met de aanvulling "2" erachter of voor.. "klantnaam2".

In bijgaand voorbeeld laat ik zien wat er bij de huidige macro uiteindelijk het resultaat is.
Wil je heb zelf uitproberen, haal dan eerst alle tabbladen weg, behalve Sheet1


Thanks

 

[HSV]

Bv.

Als het blad niet bestaat wordt er eentje aangemaakt.

For j = 1 To UBound(Split(c00, "|"))
[COLOR=#ff0000]  if iserror(evaluate("'" &  Split(c00, "|")(j) & "'!A1")) then[/COLOR]
        Sheets.Add(, Sheets(Sheets.Count)).Name = Split(c00, "|")(j)
  [COLOR=#FF0000]end if[/COLOR]
        .[T2] = "*" & Split(c00, "|")(j) & "*"
        .[A2].CurrentRegion.AdvancedFilter 2, .[T1:T2], Sheets(Split(c00, "|")(j)).[a1]


    Next j

 

[Iceje]

Hoi HSV, bedankt voor je snelle reactie!

Nu krijg ik iig niet meer die foutmelding, Echter is het de bedoeling dat de eerst serie "auto" (t/m de 1e rij met "auto totaal") in een sheet komt en de 2e serie "auto" weer in een andere Sheet met bijvoorbeeld de naam "auto2".

Nu worden de 2 series in 1 Sheet met de naam "auto" geplaatst.

 

[VenA]

Als je niet eerst met een representatief voorbeeldbestand komt dan blijven we hier alles voor jouw aan elkaar aan het programeren. Het bestand in #8 is anders dan het bestand in #14. Dus wat het nu echt moet worden?

 

[Iceje]

@VenA,

De essentie is toch hetzelfde in die 2 bestanden!? of er nu ""auto" "piet" of "Klaas" staat, dat maakt geen verschil. In werkelijkheid gaat het om klantnamen en omzet, die ga ik hier natuurlijk niet posten.
Het bestand in #8 is om aan te geven dat er meerdere kolommen mee gekopieerd dienden te worden. Dit is opgelost mede door de toevoeging van HSV, zoals ik heb aangegeven in #12

Nu is er echter een ander issue opgedoken die ik tot aan bericht #13 niet was opgevallen in mijn eigen file. Om deze representatief te maken is het bestand in #14 toegevoegd. Er staan wat andere namen in idd, maar het blijft natuurlijk hetzelfde. Ik kan me wel voorstellen dat dit kan leiden tot verwarring. Excuses hiervoor.

 

[HSV]

Het is alweer even geleden, maar ik liep toevallig even de geabonneerde vragen bij langs.

Sub hsv()
With Sheet1
    .[T1] = "product"
    ar = .Cells(1).CurrentRegion
    sn = ar
    Set odic = CreateObject("scripting.dictionary")
    For j = 2 To UBound(ar)
      v = Split(ar(j, 1))(0)
        If LCase(Right(ar(j, 1), 6)) = "totaal" Then
           
                odic.Item(v) = odic.Item(v) + 1
                c00 = c00 & "|" & Split(v)(0) & odic.Item(v)
          Else
            sn(j, 1) = Split(sn(j, 1))(0) & odic.Item(v) + 1
        End If
    Next j
 .Cells(1).Resize(UBound(ar)) = sn
   
        For j = 1 To UBound(Split(c00, "|"))
          If IsError(Evaluate("'" & Split(c00, "|")(j) & "'!A1")) Then
            Sheets.Add(, Sheets(Sheets.Count)).Name = Split(c00, "|")(j)
          End If
            .[T2] = "*" & Split(c00, "|")(j) & "*"
            .[A2].CurrentRegion.AdvancedFilter 2, .[T1:T2], Sheets(Split(c00, "|")(j)).[a1]
        Next j
 .Cells(1).Resize(UBound(ar)) = ar
End With
End Sub

edit: tweede bestand is anders.