Met macro waardes ophalen van X werkbladen en in tabel op blad 1 plaatsen

[TempoWillem]

Hallo Kenners, hier gaan we weer

Ik heb al een tijdje zitten puzzelen met wat ik al aan informatie verzameld heb (o.a. hier) maar ik krijg het toch niet werkend.

Ik heb een werkmap met daarin een hele serie tabbladen (in mijn voorbeeld blad 2 tot 11). Op al die bladen staat dezelfde indeling met eigen gegevens. Nu moeten achteraf een aantal van die gegevens van ieder tabblad naar een tabel in een andere werkmap gehaald worden. Om niet 100 bladen te moeten openen en die gegevens met de hand te kopieren wil ik een macro maken, maar dat strandt tot nog toe steeds. Ik heb een voorbeeld gemaakt en om het simpel te houden moeten de gegevens van de tabbladen op blad 1 komen. Het grootste obstakel lijkt de code om een blad te selecteren en na het uitvoeren van een opdracht verder te gaan met het volgende blad. Die opdracht op zich lukt, maar het selecteren van de bladen dus niet.

Kan iemand me vertellen wat ik fout doe, en belangrijker, hoe het wél moet?

Bij voorbaat dank!
Bekijk bijlage Probeersel.xlsb

 

[Mde]

Hoi,

je hebt niks gekopieerd in je functie.

Sub Test2()
    With Application
        For i = 2 To 11
            Sheets(i).Select
            [COLOR="#FF0000"]Range("a1:b1").Copy[/COLOR]
                With Workbooks("Probeersel.xlsb").Sheets("Week")
                .Cells(.Columns(1).SpecialCells(2).Count, 1).Offset(1).Resize(, 2) = Array([A1], [B1])
                End With
            Next i
        End With
    On Local Error GoTo 0
                
End Sub

is vast een mooiere oplossing voor maar bij mij werkt het.

 

[TempoWillem]

Marco, dank je wel!

Dit lost inderdaad het probleem tot zo ver op. Kijken of dat dan ook voor het echte bestand gaat werken...

Ik had geen kopieer opdracht omdat dat in de originele code die ik gebruikte ook niet nodig is, dus was me niet bewust daarvan. Lost het in ieder geval wel op, al houd ik me aanbevolen voor betere oplossingen en tips!

 

[VenA]

Probeer deze eens.

Sub Test2()
For Each sh In Sheets
    If sh.Name <> "Week" Then
        With Sheets("Week")
            .Cells(.Columns(1).SpecialCells(2).Count, 1).Offset(1).Resize(, 2) = Array(sh.[A1], sh.[B1])
        End With
    End If
Next sh
End Sub

 

[TempoWillem]

Probeer deze eens.

Sub Test2()
For Each sh In Sheets
    If sh.Name <> "Week" Then
        With Sheets("Week")
            .Cells(.Columns(1).SpecialCells(2).Count, 1).Offset(1).Resize(, 2) = Array(sh.[A1], sh.[B1])
        End With
    End If
Next sh
End Sub

Hey, VenA - wederom reddende engel?

Want inderdaad werkt de kopieer opdracht niet in het "echte" bestand..

Even jouw code ontledend:

If sh.Name <> "Week" Then

betekent zoveel als :
Als de naam van de sheet ANDERS is dan "Week" dan....

Zie ik dat correct? Hoe formuleer ik het als ik alle bladen met "2015" in de naam wil gebruiken?

 

[VenA]

dat zie je correct. Als de namen van de bladen bv 201501 ,201502 etc zijn dan wordt het If left(sh.name,4) = "2015" Then

 

[TempoWillem]

dat zie je correct. Als de namen van de bladen bv 201501 ,201502 etc zijn dan wordt het If left(sh.name,4) = "2015" Then

De tabbladen hebbeen een naam die uit een formulier wordt gehaald is opgebouwd uit dd-mm-2015-shift, dus bijv. 1-11-2015-middag. Hoe formuleer ik dat dan? *2015* snapt VBA niet ben ik achter gekomen... 2015 komt in alle bladen voor en alleen op de bladen die ik nodig heb.

Edit: Heb al een andere oplossing gevonden, maar wil bovenstaande best nog beantwoord als iemand bereid is....

 

[VenA]

Edit: Heb al een andere oplossing gevonden, maar wil bovenstaande best nog beantwoord als iemand bereid is....

Dan is het natuurlijk leuk om dan ook even deze oplossing te plaatsen.

Je hebt het over het formaat dd-mm-2015 en laat de datum 1-11-2015 zien. Dit is toch iets anders. Om te kijken of '2015' in de tabnaam staat kan je oa deze gebruiken

If InStr(1, sh.Name, "2015") <> 0 then

 

[snb]

'iets' anders

Sub M_snb()
  redim sn(sheets.count,1)

  For Each sh In Sheets
    If instr(sh.Name,"-2015-") Then
      sn(y,0)=sh.cells(1) 
      sn(y,1)=sh.cells(1,2)
      y=y+1
    End If
  Next

  sheets("overzicht").cells(1).resize(ubound(sn)+1,2)=sn
End Sub

 

[TempoWillem]

Dan is het natuurlijk leuk om dan ook even deze oplossing te plaatsen.

Bij deze:
Ik zat nog even naar je eerdere code te kijken (met <> "Week") en bedacht toen het zelfde toe te kunnen passen als ik maar 1 ander blad had met een andere naam. Nu waren dat er 2, maar omdat er verder met een nieuwere versie van het bestand gewerkt gaat worden kon ik die wissen. Heb "Week" dus aangepast in de naam van het ene andere blad en toen werkte alles perfect Eerlijk gezegd heb je me dus met je aanvankelijke code al aan de oplossing geholpen, nu ik er over nadenk...


snb, ook dank, ik bewaar al dit soort codes en kijk wat ik wanneer kan toepassen, en of ik begrijp wat er staat zodat ik weer wat meer van de taal leer. Ook jouw bijdrage wordt dus op prijs gesteld!