Loop through sheets in another workbook

[_eNVy_]

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.

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

 

[offthelip]

I think all you need to do is change:

Sheets(1).Activate

to

Sheets(sht).Activate

 

[gallen]

@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:

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

 

[_eNVy_]

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).