Gelijke tabbladen toevoegen aan verschillende files

[popipipo]

Ca 75 mensen hebben allen een eigen identieke file met opdrachten die ze moeten uitvoeren.
Elke maand krijgen ze er nieuwe opdrachten bij die op 2 nieuwe tabbladen staan.
In januari bestaat elke file dus uit 2 tabbladen in februari uit 4 enz enz.

Nu kan ik alle 75 files afzonderlijk die 2 tabbladen toevoegen maar dat is een hoop 'handwerk' en kost een hoop tijd
Dus kan dit ook via VBA?
De 75 files kan ik in 1 directory zetten en
De 2 toe te voegen tabbladen kan ik in 1 nieuwe file zetten met enkel deze 2 tabbladen.

 

[HSV]

Hallo Willem,

Bv.

Verwijderd.

 

[HSV]

Volgens mij had ik het verkeerd begrepen.

Sub hsv()
Dim Wb, bestandopen
Application.ScreenUpdating = False
Set Wb = Workbooks.Open("c:\users\popipipo\documents\Map1\bestandsnaam_van_ die_twee_bladen.xlsx")
 bestandopen = Dir("C:\users\popipipo\documents\Map1\*")
  Do Until bestandopen = ""
   If bestandopen <> "bestandsnaam_van_ die_twee_bladen.xlsx" Then
     Workbooks.Open "C:\users\popipipo\documents\Map1\" & bestandopen
     Wb.Sheets(Array("Blad1", "Blad2")).Copy , Sheets(Workbooks(bestandopen).Sheets.Count)
      Workbooks(bestandopen).Close 1
    End If
   bestandopen = Dir
  Loop
End Sub

 

[popipipo]

@ Harry

Sorry voor de late reactie maar ik ben niet in staat geweest de laatste paar avonden achter de pc te gaan zitten.
Maar toch dankt voor je suggestie
Ik krijg hem alleen niet werkend.
Ik denk dat het ligt aan de benaming van de tabbladen.

     Wb.Sheets(Array([Sheet2], [Sheet3])).Copy , Sheets(Workbooks(bestandopen).Sheets.Count)

Deze verschilt namelijk per maand en ik wil natuurlijk maandelijks niet de code aanpassen
Als bijlage het vereenvoudigde bestandje met de 2 tabbladen.
De bestandsnamen waar het heen gekopieerd moeten worden zijn gewoon namen.

 

[VenA]

Als er maar twee tabbladen in het bestand staan dan kan je het zo proberen

Wb.Sheets(Array([Sheet[COLOR="#FF0000"]1[/COLOR]], [Sheet[COLOR="#FF0000"]2[/COLOR]])).Copy

 

[popipipo]

Ook met deze aanpassing worden de tabbladen niet toegevoegd.

 

[VenA]

Nieuwe poging

Wb.Sheets(Array(1, 2)).Copy

 

[HSV]

Of:

 Wb.Sheets(Array[COLOR=#ff0000]("sheet2", "sheet3")[/COLOR]).Copy , Sheets(Workbooks(bestandopen).Sheets.Count)

 

[popipipo]

Helaas geven ook deze 2 aanpassingen niet het gewenste resultaat.
Er gebeurt gewoon niets???
Zou het dan toch aan een andere code regel liggen?

 

[VenA]

Na de copy gaat het inderdaad niet lekker. Even een kleine test opstelling gemaakt zonder het openen en sluiten van de bestanden.

Sub VenA()
Set Wb = ActiveWorkbook
Wb.Sheets(Array(1, 2)).Copy , Workbooks("Map1.xlsb").Sheets(Sheets.Count + 1)
End Sub

Dit werkt bij mij correct.

Met de code van HSV zal het dan zo worden.

Sub hsv()
Dim Wb, bestandopen, j As Long
Application.ScreenUpdating = False
Set Wb = Workbooks.Open("D:\test map\origineel.xlsm")
 bestandopen = Dir("D:\test map\*")
  Do Until bestandopen = ""
   If bestandopen <> "origineel.xlsm" Then
     Workbooks.Open "D:\test map\" & bestandopen
     'Wb.Sheets(Array([Sheet2], [Sheet3])).Copy , Sheets(Workbooks(bestandopen).Sheets.Count)
     Wb.Sheets(Array(1, 2)).Copy , Workbooks(bestandopen).Sheets(Sheets.Count + 1)
     
      Workbooks(bestandopen).Close 1
    End If
   bestandopen = Dir
  Loop
End Sub

 

[HSV]

@VenA,

Die +1 kan niet.
De komma die er staat betekent???


Test het zo maar eens Willem (ik wist niet dat het bestand met de twee bladen ook het bestand met de code was).

Sub hsv()
Dim bestandopen
Application.ScreenUpdating = False
 bestandopen = Dir("D:\test map\*")
  Do Until bestandopen = ""
   If bestandopen <> "origineel.xlsm" Then
     Workbooks.Open "D:\test map\" & bestandopen
     ThisWorkbook.Sheets(Array(1, 2)).Copy , Sheets(Workbooks(bestandopen).Sheets.Count)
      Workbooks(bestandopen).Close 1
    End If
   bestandopen = Dir
  Loop
End Sub

 

[VenA]

Die +1 kan niet.
De komma die er staat betekent???

Voor sheets.add after? Volgens mij is dit een , voor de sheets.add om de gegevens achter de laatste tab te zetten. En werkt het niet bij .copy

 

[HSV]

Je zit te klooien met Activeworkbook en ThisWorkbook.
En het heeft niets van doen met sheets.add.

Worksheets("Sheet1").Copy After:=Worksheets("Sheet3")

 

[popipipo]

De oplossing van Harry gegeven in #11 ga ik gebruiken.
Hartelijk dank voor jullie bijdrage.

 

[VenA]

Je zit te klooien met Activeworkbook en ThisWorkbook.

Klooien is inderdaad het goede woord. Doe ik dat niet dan leer ik ook niets

@popipipo,

Mooi dat het opgelost is.

 

[HSV]

@VenA,

Maakt niet uit, ik moet toegeven dat je het snel hebt geleerd. :thumb:
Ik heb overigens de codes voor het openen van bestanden wel korter gezien; die gebruik ik niet opdat ik ze gewoonweg niet begrijp.