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