Results 1 to 4 of 4

Thread: Loop through sheets in another workbook
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Feb 2018
    Posts
    14
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Loop through sheets in another workbook

    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

  2. #2
    Board Regular
    Join Date
    Dec 2017
    Location
    UK
    Posts
    903
    Post Thanks / Like
    Mentioned
    37 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Loop through sheets in another workbook

    I think all you need to do is change:
    Code:
    Sheets(1).Activate
    to
    Code:
    Sheets(sht).Activate
    Speed up your code use variant arrays and NEVER ACCESS THE WORKSHEET IN A LOOP

  3. #3
    Board Regular gallen's Avatar
    Join Date
    Jun 2011
    Location
    Manchester UK
    Posts
    1,895
    Post Thanks / Like
    Mentioned
    21 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Loop through sheets in another workbook

    @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
    Dim wb As Workbook, ws As Worksheet, wbDump As Workbook, wsdump As Worksheet
    
        ' 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)
        
        '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
        
        'set the data dump worksheet variable
        Set wsdump = wbDump.Sheets("RawData")
        
        
        For Each objFile In objFolder.Files
        
            '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
            
                
                '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 by gallen; Sep 23rd, 2019 at 06:09 AM.

    - forum use guidelines, forum rules and terms of use

    - Try searching for your answer first, see how

    - Read the FAQs

    - List of BB codes


  4. #4
    New Member
    Join Date
    Feb 2018
    Posts
    14
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Loop through sheets in another workbook

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

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •