Copy uit een bepaalde sheet

[HWV]

Beste,

Ik heb een code om excel bestanden die in een bepaalde DIR staan te kopieeren naar één blad in een ander bestand.
In mijn geval heb ik de bestanden staan in D:\test\ ik heb daar nu een aantal bestanden in staan met verschillende werkbladen.

Een voorbeeld
Blad1, Blad2, Opslag

Nu kopieer deze code de active werkblad, dus als ik het bestand opslaat met Blad1 in zicht dan zal hij deze kopieeren naar het nieuwe blad.

Mijn vraag is nu, ik zou graag enkel het werkblad Opslag willen kopieeren.

Hoe kan ik dit in de code verwerken dat hij enkel dit blad kopieer.
In al mijn andere bestanden komt ook het werkblad Opslag voor, die wil ik allemaal verzamelen op één Sheet.

Kunnen jullie mij hierbij helpen.

Sub MergeSheets()
    Dim SrcBook As Workbook
    Dim fso As Object, f As Object, ff As Object, f1 As Object
       
    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.Getfolder("d:\test\")
    Set ff = f.Files
    
    For Each f1 In ff
        Set SrcBook = Workbooks.Open(f1)
        Range("A1:IV" & Range("A65536").End(xlUp).Row).Copy
        ThisWorkbook.Worksheets(1).Activate
        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
        Application.CutCopyMode = False
        SrcBook.Close
    Next
End Sub

Bedankt
HWV

 

[Hoornvan]

HWV,

Als je de 1 nu eens veranderd in een 3.

ThisWorkbook.Worksheets(1).Activate

Ik heb er niet veel verstand van maar probeer het wel.
Voor de zekerheid maak eerst een copy van de file voordat het mis gaat.

 

[HWV]

Moet je eerst zeker weten

Beste,

Bedankt voor de snelle reactie,

De 1 veranderen in drie zou willen zeggen dat ik altijd het derde blad wil seleceteren.
Helaas is dit altijd zo, ik heb soms maar één blad of twee of meerdere.
Met de verandering van de code, gebeurdt er ook niks, enkel dat hij waar hij het heen verplaatst veranderd van blad 1 naar blad 3
Hij pak de active blad en kopieer deze dan.

Toch bedankt voor het mee denken

HWV

 

[Hoornvan]

HWV,

En als je tussen de ( zet ("Opslag")

 

[HWV]

Fout melding op Oplsag

Beste,

Helaas krijg ik een fout melding op deze oplossing,
Had ik zelf al geprobeerd.
Maar ik blijf ook verder zoeken .
Bedankt.

HWV

 

[Wigi]

Ongeteste code

Sub MergeSheets()

    Dim SrcBook As Workbook
    Dim SrcSheet As Worksheet
    Dim fso As Object, f As Object, ff As Object, f1 As Object
       
    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.Getfolder("d:\test\")
    Set ff = f.Files
    
    For Each f1 In ff
        Set SrcBook = Workbooks.Open(f1)
        Set SrcSheet = SrcBook.Worksheets("Opslag")
        With SrcSheet
            .Range("A1", .Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Copy
            ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlValues
            .Parent.Close savechanges:=False
        End With
    Next
    
    Set SrcBook = Nothing
    Set SrcSheet = Nothing
    
    Application.CutCopyMode = False
    
End Sub

Wigi

 

[HWV]

Beste Wigi,

Bedankt voor de reactie,

Helaas ik krijg een foutmelding op onder staande

.Range("A1", .Range("A" & Rows.Count).End(xlUp).Row).EntireRow.Copy

Ik hoop dat we er uit kunnen komen, en dat ik een juiste code hiervoor zal vinden.

bedankt

HWV

 

[Wigi]

Haal .Row eruit.

 

[HWV]

Toch nog een opmerking

Het script werkt, bedankt.
Nu geef hij de melding dat er een grote hoeveelheid staat op het klembord en of ik dit in het andere document wil plakken wat dus waar is.
Kan ik dit ook nog omzeilen

groet HWV

 

[Wigi]

Misschien met:

Application.DisplayAlerts = False
'code
Application.DisplayAlerts = True

Wigi

 

[HWV]

Bedankt het werkt

Ik heb de aanpassingen toegevoegd en het werkt perfect bedankt Wigi


HWV