Filteren en overzetten naar tabbladen op basis van inhoud

[stefano]

Beste,

Ik heb een bestand in bijlage waar een reeks data in vermeld worden. De kolom info bevat verschillende gegevens die ik liefst automatisch ( via macro ) zou willen overzetten naar verschillende tabbladen. Hoe zou ik dit kunnen bewerkstelligen?

dank alvast,

StefanoBekijk bijlage Parmie.xlsx

 

[VenA]

Probeer het zo eens.

Sub VenA()
For Each sh In Sheets
    If sh.Name <> "Blad1" Then
        With Sheets("Blad1").Cells(1).CurrentRegion
            .AutoFilter 12, "=*" & sh.Name & "*"
            .Copy sh.[a1]
            .AutoFilter
        End With
    End If
Next sh
End Sub

 

[stefano]

Super ! Dit is wat ik zocht. DJW VenA !

 

[stefano]

Oeps, wanneer de gegevens in elk tabblad geplakt worden dan zou ik eerst willen hebben dat de inhoud van het tabblad gewist wordt. Kan dit er nog bij aub ?

Mocht bovendien naast blad1 nog een tabblad uitgesloten moeten worden, welke code komt er dan te staan?

    If sh.Name <> "Blad1" Then

 

[VenA]

Probeer deze eens.

Sub VenA()
For Each sh In Sheets
    If sh.Name <> "Blad1" And sh.Name <> "Blad2" Then
        sh.Cells.Clear
        With Sheets("Blad1").Cells(1).CurrentRegion
            .AutoFilter 12, "=*" & sh.Name & "*"
            .Copy sh.[a1]
            .AutoFilter
        End With
    End If
Next sh
End Sub

of

Sub VenA()
For Each sh In Sheets(Array("Arkeos", "Bagou", "Glasgow", "Paledor"))
    sh.Cells.Clear
    With Sheets("Blad1").Cells(1).CurrentRegion
        .AutoFilter 12, "=*" & sh.Name & "*"
        .Copy sh.[a1]
        .AutoFilter
    End With
Next sh
End Sub

 

[stefano]

En als ik nu ipv het volledige werkblad enkel de rijen 6 tot einde wil wissen

Sub VenA()
For Each sh In Sheets
    If sh.Name <> "Blad1" And sh.Name <> "Blad2" Then
        [COLOR="#FF0000"]sh.Cells.Clear[/COLOR]
        With Sheets("Blad1").Cells(1).CurrentRegion
            .AutoFilter 12, "=*" & sh.Name & "*"
            .Copy sh.[a1]
            .AutoFilter
        End With
    End If
Next sh
End Sub

 

[snb]

@ste

Dan moet je de code die je gekregen hebt aanpassen.
En eerst maar eens goed nadenken over alle volgende nieuwe wensen.

Dit lijkt me echt een advancedfilter klusje.

 

[VenA]

Als de kopie in A1 geplaatst wordt lijkt het mij vrij onzinnig om de eerste 6 rijen niet leeg te maken. Verder sluit ik mij aan bij de opmerkingen/tip van snb.

Met de tip was ik niet echt bekend maar werkt een stuk sneller. En ja dat kost mij ook wat uitzoeken en kan ongetwijfeld beter

Sub VenA()
With Sheets("Blad1")
    .[Z1] = .[L1]
    For Each sh In Sheets(Array("Arkeos", "Bagou", "Glasgow", "Paledor"))
    .[Z2] = "*" & sh.Name & "*"
    .Cells(1).CurrentRegion.AdvancedFilter 2, .[Z1:Z2], sh.[A1]
    Next sh
    .[Z1:Z2] = ""
End With
End Sub

 

[stefano]

Beste mensen,

Mocht ik alle toeters en bellen en wensen van mensen rondom me kennen dan zou ik enerzijds mijn vraag in 1 keer stellen en ook duidelijk genoeg proberen te formuleren. Anderzijds heb ik geen enkele kennis van programmeren of dergelijke. Ik probeer echt wel zelf naar een oplossing te zoeken, maar het stukje vba hieronder snap ik al niet helemaal, laat staan dat ik het zelf in elkaar zou kunnen steken. Ik ga op mn 55ste geen wonderen daaromtrent meer verrichten.

sorry voor het ongemak, ook dank voor de aangeboden hulp.

Stefaan

 

[snb]

De meeste helpers hier zijn veel ouder dan jij.