meerdere werbladen selecteren vanuit excel

[DickVoois]

Ik heb een bestand met ongeveer 20 werkbladen. Per werkblad staan de klantgegevens van een verkoper.

in een tabel heb ik de volgende gegevens staan
werkblad verkoper team
piet Piet de jong Rood
klaas klaas de vries Rood
henk henk de jong Rood
Marieke marieke de vries Groen
dick dick de boer Groen

via een knop wil ik de werkbladen van één team selecteren ( en printen, maar dat lukt me wel)


via onderstaande code kan ik wel meerdere werkbladen selecteren, maar niet de seleectie die ik zoek.

Sub xxxAfprintenMeerdereBladen()
Dim strWB() As String
Dim i As Integer
Dim iAantal As Integer
iAantal = 3 'aantal geselecteerde te printen bladen is bijvoorbeeld 3
ReDim strWB(0 To iAantal - 1)
For i = 1 To iAantal
strWB(i - 1) = Sheets(i).Name
Next
Sheets(strWB).Select
ActiveWindow.SelectedSheets.PrintPreview
End Sub

Ik wil in 1x de verkopers uit team 1 selecteren.

 

[dprod]

Ik denk dat ik je volg, alleen weet ik niet waar je de groep naam zet in het werkblad van de betreffende werknemers. Als voorbeeld even snel een code (niet getest hier, zit nu op linux).

STEL dat je in Range("A1") de kleur zet (of groep naam/nummer... wat jij wilt).

Sub PrintVolledigeGroepMedewerkers()

    Dim ws As Worksheet
    Dim strGroep As String

strGroep = "Rood"

For Each ws in Worksheets
    If ws.Range("A1").Value = strGroep Then
        ws.PrintPreview
    End If
Next

End Sub

Gebruik eventueel achter de String: strGroep = een "InputBox" om diverse groepen uit te kunnen printen.
Overigens print hij op deze manier de werkbladen die aan je groep voldoen, achter elkaar uit.
Hij selecteert nu niet alle bladen tegelijk.
Mocht je dit wel willen kun je dat inderdaad d.m.v. Array doen, vul deze dan in de For Each loop (zoals boven omschreven).

Gr,
dprod

 

[Mark xl]

Beste Dickvoois,

Ik heb ook iets bedacht om je bladen te selecteren, ongeveer op dezelfde manier die jij doet, dmv een matrix

Ik laat de gebruiker na het starten van de macro een groep kiezen.
Plaats deze Subroutine in een nieuwe module

Option Explicit
Option Compare Text         'Hoofdletters negeren, werkblad selectie is niet hoofdletter gevoelig

Sub Selecteer_Werkbladen()
'Selecteer werkbladen
'   let goed op dat de Werkbladnamen hoofdlettergevoelig zijn
Dim sTeam  As String
Dim Bladen As String
Dim Selectie As Variant

    sTeam = InputBox("Selecteer een team.", _
                        "Bladen selecteren", _
                        "rood")
    
    Bladen = VindSheets(sTeam)
    
    If Bladen = "" Then
    
        MsgBox "De groep is niet gevonden", vbInformation
    
    Else
    
        Selectie = Split(Bladen, vbCr)
        On Error GoTo FouteNaam
        sheets(Selectie).Select

    End If
    
    Exit Sub
'Foutafhandeling
FouteNaam:

    MsgBox "De waarde van een cel komt niet overeen met een bestaand werkblad" & vbCr & _
            "controleer de naam of kijk of er bijvoorbeeld extra spaties aanwezig zijn" _
            , vbInformation

End Sub

En plaats deze functie eronder:

Private Function VindSheets(ByVal zoeknaam As String) As String
'maak een delimited string van werkbladnamen uit "Tabel"
Dim Tabel As Range
Dim cell As Range
Dim strGroep As String
    
    'de tabel(zonder headers)
    Set Tabel = Range("A2:C6")
    
    For Each cell In Tabel.Columns(3).Cells   'de groep
        

        If cell = zoeknaam Then

            'cell.offset(0, -2) = de naam van de verkoper                                
            strGroep = strGroep & cell.Offset(0, -2).Value & vbCr
        
        End If
        
    Next
    
    On Error Resume Next
    VindSheets = Mid(strGroep, 1, Len(strGroep) - 1)
    
End Function

Je kunt dan zelf in de code het bereik van de Tabel aanpassen, of dit eventueel uitbreiden met een Application.inputbox met type Range.

Sorry voor de iets langere code, maar ik houd het graag duidelijk en probeer fouten op te vangen , zodat je niet elke uitzondering een bericht krijgt met
"De programmacode is onderbroken [bla, bla, bla...]"

hopelijk brengt dit je op de goede weg....Succes!

 

[dprod]

Mocht je voldoende hebben aan bovenstaande oplossingen, zet de status dan even op opgelost. :thumb:
Geef eventueel ook je eigen oplossing als je daar behoefte aan hebt.

Dank en Groeten,
dProd