Loop through sheets in another workbook

_eNVy_

Board Regular
Joined
Feb 9, 2018
Messages
66
Office Version
  1. 365
Platform
  1. Windows
Hi all,

Need some help adding some coding to loop through tabs in another workbook.
The code opens up a file(s) in a specific folder and the aim is to just copy all data in all tabs into one tab within DataDump file.

Code:
Sub Execute_Files()Dim objFSO As Object, objFolder As Object, objFile As Object
Dim Path As String
Dim ThisWorkbook As String
Dim sht As Integer




' VBA to access and extract data from SharePoint to file within SharePoint.
' This looks at every file in the SharePoint site.


DataFile = "DataDump_v2.xlsb"


RowNumber = 2


' Define paths to folders that contain files to execute


Path = "C:\Users\040428\Desktop\LiamG\Excel_development_work_for_Brick_by_Brick_\Timesheets\"
Application.DisplayAlerts = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(Path)


For Each objFile In objFolder.Files
Workbooks.Open Filename:=Path & objFile.Name




For sht = 1 To Workbooks(objFile.Name).Worksheets.Count


'here need to add something to + 1 sheet


Workbooks(objFile.Name).Activate


Sheets(1).Activate
Application.AskToUpdateLinks = False






Range("C17:G33").Copy


Windows("DataDump_v2.xlsb").Activate
Sheets("RawData").Select
        Range("C" & RowNumber).PasteSpecial Paste:=xlPasteValues
    
   
Workbooks(objFile.Name).Activate
Range("D3:G3").UnMerge
Range("D3").Copy


Windows("DataDump_v2.xlsb").Activate
Range("A" & RowNumber).PasteSpecial Paste:=xlPasteValues
Range("A" & RowNumber).AutoFill Destination:=Range("A" & RowNumber & ":A" & Range("D" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select


RowNumber = RowNumber + 19


Application.CutCopyMode = False


Next sht


Windows("DataDump_v2.xlsb").Activate


Workbooks(objFile.Name).Close savechanges:=False


Next
Application.DisplayAlerts = True
End Sub
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
I think all you need to do is change:
Code:
Sheets(1).Activate
to
Code:
Sheets(sht).Activate
 
Upvote 0
Solution
@offthelip is correct. However you should never have to use Activate or Select in your code where possible.

I've started you off below to show you that you don't need to do that and use variables instead:

Code:
Sub Execute_Files()
Dim objFSO As Object, objFolder As Object, objFile As Object
Dim Path As String
Dim ThisWorkbook As String
Dim sht As Integer
[COLOR=#ff0000]Dim wb As Workbook, ws As Worksheet, wbDump As Workbook, wsdump As Worksheet[/COLOR]

    ' VBA to access and extract data from SharePoint to file within SharePoint.
    ' This looks at every file in the SharePoint site.
    
    
    DataFile = "DataDump_v2.xlsb"
    
    
    RowNumber = 2
    
    
    ' Define paths to folders that contain files to execute
    
    
    Path = "C:\Users\040428\Desktop\LiamG\Excel_development_work_for_Brick_by_Brick_\Timesheets\"
    Application.DisplayAlerts = False
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(Path)
    
[COLOR=#ff0000]    'this only works if workbook is open
    On Error Resume Next
    Set wbDump = Workbooks("DataDump_v2.xlsb")
    On Error GoTo 0
    
    'if wbdump is nothing then "DataDump_v2.xlsb" isn't open
    If wbDump Is Nothing Then
        MsgBox "DataDump_v2.xlsb is not open.", vbCritical, "Error"
        Exit Sub
    End If[/COLOR]
    
[COLOR=#ff0000]    'set the data dump worksheet variable
    Set wsdump = wbDump.Sheets("RawData")[/COLOR]
    
    
    For Each objFile In objFolder.Files
    
     [COLOR=#ff0000]   'set variable to the next wrokbook in the folder
        Set wb = Workbooks.Open(Filename:=Path & objFile.Name)
        
        For Each ws In wb.Worksheets
            'copy
            ws.Range("C17:G33").Copy
            'paste
            wsdump.Range("C" & RowNumber).PasteSpecial Paste:=xlPasteValues
            
            'I get a little confused at this point about what ius copying form where.
            'But in essence, don't 'select' or 'Activate' where possible. _
            instead use variables as I have done above.
            
            
        Next ws[/COLOR]
        
            
            'here need to add something to + 1 sheet
            
            
    '        Workbooks(objFile.Name).Activate
    '
    '
    '        Sheets(1).Activate
    '        Application.AskToUpdateLinks = False
    '
    '
    '
    '
    '
    '
    '        Range("C17:G33").Copy
    '
    '
    '        Windows("DataDump_v2.xlsb").Activate
    '        Sheets("RawData").Select
    '                Range("C" & RowNumber).PasteSpecial Paste:=xlPasteValues
    '
    '
    '        Workbooks(objFile.Name).Activate
    '        Range("D3:G3").UnMerge
    '        Range("D3").Copy
    '
    '
    '        Windows("DataDump_v2.xlsb").Activate
    '        Range("A" & RowNumber).PasteSpecial Paste:=xlPasteValues
    '        Range("A" & RowNumber).AutoFill Destination:=Range("A" & RowNumber & ":A" & Range("D" & Rows.Count).End(xlUp).Row)
    '        Range(Selection, Selection.End(xlDown)).Select
    '
    '
    '        RowNumber = RowNumber + 19
    '
    '
    '        Application.CutCopyMode = False
        
        
    '    Next sht
        
        
        Windows("DataDump_v2.xlsb").Activate
        
        
        Workbooks(objFile.Name).Close savechanges:=False
    
    
    Next objFile
    Application.DisplayAlerts = True
End Sub
 
Last edited:
Upvote 0
Thank you gallen for your reply.

I have added offthelip's section and it works great.

Regarding my code : it is meant to copy the range C17:G33 in objFile.Name and paste in DataDump file, then go to the next tab and do the same process until there are no more tabs. It should paste after every 19 rows (hence the RowNumber + 19 section of my code).
 
Upvote 0

Forum statistics

Threads
1,223,885
Messages
6,175,183
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top