Kopieer een blad van elke werkmap naar uw werkmap in een map met VBA in Microsoft Excel

• De macro kopieert een deel van het eerste werkblad van elk bestand dat zich in de map C:\Data bevindt naar het eerste werkblad van uw werkmap.
• De eerste macro doet een normale kopie en de tweede macro kopieert de waarden.

Het kopieert het eerste blad van elke werkmap naar de werkmap waar de code zich in bevindt.
De bladnaam is de naam van de werkmap.

Sub CopySheet() Dim basebook As Workbook Dim mybook As Workbook Dim i As Long Application.ScreenUpdating = False With Application.FileSearch .NewSearch .LookIn = "C:\Data" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Stel vervolgens basebook in = ThisWorkbook For i = 1 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) mybook.Worksheets(1).Copy after:= _ basebook.Sheets(basebook.Sheets.Count) ActiveSheet.Name = mybook.Name mybook.Close Next i End If End With Application.ScreenUpdating = True End Sub

Voor deze sub(TestFile4_values) moet u onbeveiligde werkbladen hebben, of de beveiliging opheffen in de code.

Sub CopySheetValues() Dim basebook As Workbook Dim mybook As Workbook Dim i As Long Application.ScreenUpdating = False With Application.FileSearch .NewSearch .LookIn = "C:\Data" .SearchSubFolders = False .FileType = msoFileTypeExcelWorkbooks If > .Execute() 0 Stel vervolgens basebook in = ThisWorkbook For i = 1 To .FoundFiles.Count Set mybook = Workbooks.Open(.FoundFiles(i)) mybook.Worksheets(1).Copy after:= _ basebook.Sheets(basebook.Sheets.Count) ActiveSheet.Name = mybook.Name With ActiveSheet.UsedRange .Value = .Value End With mybook.Close Next i End If End With Application.ScreenUpdating = True End Sub