Eén nieuw tabblad toevoegen in heel veel excel documenten

[marman]

Dag allemaal,

Voor onze loonadministratie heeft elke werknemer een persoonlijk exceldocument.
Wegens nieuwe afspraken moet er extra info worden verzameld.
Dit willen we realiseren in een nieuw tabblad.
De werkwijze die ik hoop te vinden gaat als volgt:
Ik maak dit nieuwe tabblad volledig in orde met alle formules erop en eraan in één van de loondocumenten
Via een script kan ik dit specifieke tabblad met inhoud kopiëren naar de 100 andere documenten zonder deze één voor te moeten openen en de actie copy en paste hoef uit te voeren.
Alle loondocumenten staan in één folder en de naam van elk bestand begint met "loondocument - ". Dus dit zou ik kunnen gebruiken om het script duidelijk te maken bij welke documenten deze actie moet uitgevoerd worden.
Ik hoop dat jullie mijn vraag begrijpen en nog meer hoop ik dat er een oplossing bestaat voor dit probleem.

alvast veel dank voor jullie interesse in dit issue,

vriendelijke groet,

Marc

 

[SjonR]

Ik denk dat je even wat meer info moet geven. Bijvoorbeeld:

Welke folder betreft het?
Wat staat er allemaal in die folder?

En even een voorbeeldbestandje plaatsen.

 

[marman]

Bedankt voor je reactie SjonR!
In bijlage is een voorbeeld van een Loondocument toegevoegd.
Dit is het loondocument van één specifieke persoon (geanonimiseerd uiteraard).
In de folder X:\Loondocumenten 2020\ zitten er zo een 100-tal gelijkaardige documenten waarvan de naam telkens begint met "LOONDOCUMENT 2020 -" aangevuld met de naam van de werknemer.
In het bestand in bijlage zie je een tabblad "Totalen". Hierin zitten formules die data verzameld van de overige tabbladen in hetzelfde document.
Nu zoek ik een manier om dit tabblad "Totalen" op een zo eenvoudig mogelijk manier in de 100 andere documenten te krijgen want die hebben dit tabblad nog niet.
En uiteraard zo dat de formules op dit tabblad dan ook werken met de data van het document waarin het zicht bevindt.

Ik hoop dat dit al een beetje meer licht op de zaak werpt?

alvast bedankt,

vriendelijke groet,

Marc Mangelschots

 

[JEC.]

Ik denk zoiets.

Wel even je pad aanpassen naar de juiste.
Ik heb het getest en bij mij werkt het, ik krijg de gewenste resultaten.

Sub j()
Dim myfolder As String
Dim myFile As String
Dim wbData As Workbook
Dim wbSource As Workbook
Dim wsSource As Worksheet

Set wbSource = ActiveWorkbook
Set wsSource = wbSource.Worksheets("totalen")

Application.ScreenUpdating = False
myfolder = "X:\Loondocumenten 2020\LOONDOCUMENT 2020........\"
myFile = Dir(myfolder & "*.xlsx")
    Do While myFile <> ""
        Set wbData = Workbooks.Open(myfolder & myFile)
            wsSource.Copy Before:=ActiveWorkbook.Sheets("jan 20")
            ActiveSheet.Name = "Totalen"
            ActiveSheet.Cells.Replace What:="'", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
            ActiveSheet.Cells.Replace What:="[LOONDOCUMENT 2020 xxx.xlsm]", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
            ActiveWorkbook.Save
            ActiveWorkbook.Close
            Set wbData = Nothing
        myFile = Dir
    Loop
    Set wsSource = Nothing
Application.ScreenUpdating = True
End Sub

 

[HSV]

In Vba is ...

wsSource.Copy

gewoon...

thisworkbook.sheets(1).copy

En.....

ActiveWorkbook.Save
ActiveWorkbook.Close

.....kan zo worden geschreven.

 ActiveWorkbook.Close true

oftewel:

activeworkbook.close savechanges:=true

 

[JEC.]

Bedankt voor de aanvulling, leer ik ook weer van

 

[marman]

Veel dank aan HSV en JVeer!
Dit doet wat het moet doen, heerlijk!
Petje af, jullie zijn helden!
Bij deze sluit ik deze vraag.

vriendelijke groet,

Marc

 

[VenA]

Ik zou er wat controles inbouwen.

Sub VenA()
  c00 = "E:\Temp\"
  Application.ScreenUpdating = False
  ar = Split(CreateObject("WScript.Shell").Exec("cmd /c dir /b " & c00 & "*.xls*").StdOut.readall, vbCrLf)
  x = Sheets("totalen").Range("C4:N4").Formula
  For j = 0 To UBound(ar) - 1
    If Left(LCase(ar(j)), 17) = "loondocument 2020" And ar(j) <> ThisWorkbook.Name Then
      With Workbooks.Open(c00 & ar(j))
        If IsError(Evaluate("totalen!a1")) Then
          ThisWorkbook.Sheets("totalen").Copy .Sheets("jan 20")
          Range("C4:N4") = x
        End If
        .Close True
      End With
    End If
  Next j
End Sub

Nb. Mij lijkt 100 bestanden met 14 tabjes een vrij omslachtige manier om een urenadministratie bij te houden.

 

[marman]

Dankjewel voor de aanvulling VenA!
Die controles ga ik toevoegen.
Ik begrijp je opmerking i.v.m. de omslachtige werkwijze.
We doen dit zo omdat elke werknemer zelf zijn prestaties per dag invult.
En een prikklok of zo niet gewenst is.
mvg,
Marc