250 losse .xls files met 3 tabs in 1 groot bestand met alleen eerste tab zetten

Status
Niet open voor verdere reacties.
D

dek8

Gebruiker
Lid geworden
18 mrt 2018
Berichten
50
Hallo!

Ik heb onderstaande code gevonden op Internet t.b.v. bovenstaande uitdaging, te weten:

- Ik heb 250 losse .xls mappen, elk met 3 tabs
- Ik heb alleen 'blad1' nodig van elk blad (ze heten ook allemaal blad 1)
- Ik wil vervolgens alle blad1 tabs in een groot bestand hebben (ipv 250 losse files)
- Onderstaande code - welke ik op Internet vond - werkt, alleen krijg ik dan alle drie de tabbladen

Ik hoop dat iemand een ontbrekend stukje code voor me heeft waarop ik nu alleen nog de eerste tab krijg?

Code: 
Sub GetSheets()
Path = "C:\Users\dt\Desktop\dt kte\"
Filename = Dir(Path & "*.xls")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
End Sub

Ik zou de leden van dit forum zeer erkentelijk zijn, waarvoor dank!
 
Laatst bewerkt:
probeer dit eens:

Code: 
Sub GetSheets()
Path = "C:\Users\dt\Desktop\dt kte\"
Filename = Dir(Path & "*.xls")
    Do While Filename <> ""
        Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
            For Each Sheet In ActiveWorkbook.Sheets
                If Sheet.Name = "Blad1" Then
                    Sheet.Copy After:=ThisWorkbook.Sheets(1)
                End If
            Next Sheet
    Workbooks(Filename).Close
    Filename = Dir()
  Loop
End Sub

Of:

Code: 
Sub GetSheets()
Path = "C:\Users\dt\Desktop\dt kte\"
Filename = Dir(Path & "*.xls")
    Do While Filename <> ""
        Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
         
        Sheets("Blad1").Copy After:=ThisWorkbook.Sheets(1)
        
        Workbooks(Filename).Close
        Filename = Dir()
    Loop
End Sub
 
Laatst bewerkt:
Oops, ik heb nog een nabrander. Hij noemt de tabbalden nu blad 1 (1), blad 1 (2), blad 1 (3) etc etc.....Eigenlijk wil ik graag blad 1, blad 2, blad 3, dus automatische nummering....Is dat makkelijk toe te voegen? Dank!
 
Deze?
Code: 
Sheet.Copy After:=ThisWorkbook.Sheets(1)
ActiveWindow.ActiveSheet.Name = "Blad " & ActiveSheet.Index
 
Of vlotter:

Code: 
Sub M_snb()
   c00 = "C:\Users\dt\Desktop\dt kte\"
   c01 = Dir(c00 & "*.xls")

    Do While c01 <> ""
        with getobject(c00 & c01)
           .Sheets("Blad1").Copy , Sheets(sheets.count)
           .Close 0
        end with
 
        sheets(sheets.count).name="Blad" & sheets.count
        c01=Dir
    Loop
End Sub

PS. Zorg ervoor dat je werkboek maar 1 werkblad heeft voordat je de macro start.
 
Laatst bewerkt:
Dank antwoorden. Bij die laatste krijg ik foutmelding 432 dat hij 'een bestandsnaam niet kan vinden'.
Voor de goede orde - u heeft het gemerkt - ben ik geen VBA kenner.
Moet ik die code van SNB dan inpassen in de code van John/R, of is dat iets wat ik moet uitvoeren NA dat de code van John/R heeft gerund (ws niet omdat er maar 1 tabblad moet zijn, zie de PS van SBN)
Ik ben er nu vanuit gegaan dat de code van SNB de totale code is....maar dan komt hij dus met 432.
 
Dit is inderdaad de hele, voldoende code. Ik heb hem aangepast.
 
Laatst bewerkt:
OK thanks!

Foutcoude 438 nu (deze eigenschap of methode wordt niet ondersteund door dit object)
Sheets(Sheets.Count) = "Blad" & Sheets.Count
 
aanvulling.
Code: 
 sheets(sheets.count)[COLOR=#0000ff].name [/COLOR]="Blad" & sheets.count
 
@HSV

Bedankt :thumb:

Ik heb hem/haar ook opgenomen in de code.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan