Ignore Hidden Sheet & AutoFill Fail Safe

[_eNVy_]

Hi all,


I have managed to make a loop which looks through all tabs in all files (both tabs and files are unspecified). The code copies a set of data and pastes into a Data Dump file.
There is a problem when there is only ONE entry in any tab due to the AutoFill section of the macro. Would anyone be able to help with adding a fail safe for this so it doesn't error even with one entry and carries on?


The other problem is that there are hidden sheets within the files I am copying data from. Can these hidden tabs be ignored so it isn't picked up?

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.


ThisWorkbook = "DataDump_v2.xlsb"
Application.AskToUpdateLinks = False
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




'here need to add something to + 1 sheet


Workbooks(objFile.Name).Activate
Sheets(1).Activate


'The start of the bulk code work


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




Workbooks(objFile.Name).Activate
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


Workbooks(objFile.Name).Activate
ActiveSheet.Next.Activate


Next sht


Windows("DataDump_v2.xlsb").Activate


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


Next
Application.DisplayAlerts = True
End Sub

 

[_eNVy_]

WAAAAITT!!!

I got it to work!!!!

THANK YOU SO MUCH!!!!!!!



Original Post: Well and truly, the name should be in cell D3 as the file is that person's file.

I think it might be best to put it in all 19 rows regardless of how much data is pulled in. Would using the first tab's D3 be the best place to grab this from?

Just found a fundamental error on my side. I need to include range D9 on every sheet also as this references what Period number the work has been done in.

wsData.Range("B" & Rw & ":B" & wsData.Range("D" & Rows.Count).End(xlUp).Row).Value = ws.Range("D9").Value

Added this code and since D9 has already been filled on every tab (Period 1 to 12) it pastes over the pasted Periods (1 to 11).

- Thank you very much for your help and support -

 

[Fluff]

In that case try

Sub eNVy()
   Dim Wbk As Workbook
   Dim ws As Worksheet, wsData As Worksheet
   Dim Fname As String, Pth As String
   Dim Rw As Long
   
   Set wsData = Workbooks("DataDump_v2.xlsb").Sheets("RawData")
   Rw = 2
   Pth ="C:\Users\040428\Desktop\LiamG\Excel_development_work_for_Brick_by_Brick_\Timesheets\"
   Fname = Dir(Pth & "*.xls*")
   
   
   Do While Fname <> ""
      Set Wbk = Workbooks.Open(Pth & Fname)
      For Each ws In Wbk.Worksheets
         If ws.Visible = xlSheetVisible Then
            wsData.Range("C" & Rw).Resize(17, 5).Value = ws.Range("C17:G33").Value
            wsData.Range("A" & Rw).Resize(17).Value = ws.Range("D3").Value
            Rw = Rw + 19
         End If
      Next ws
      Wbk.Close False
      Fname = Dir()
   Loop
End Sub

 

[mohadin]

Hi Mohadin,

Where would you place that code? I am assuming this is for the Auto Fill problem I encounter.

For sht = 1 To Workbooks(objFile.Name).Worksheets.Count
On Error Resume Next