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

 

[mohadin]

Hi
you can use

On Error Resume Next

 

[Fluff]

How about

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 & ":A" & wsData.Range("D" & Rows.Count).End(xlUp).Row).Value = Ws.Range("D3").Value
            Rw = Rw + 19
         End If
      Next Ws
      Wbk.Close False
      Fname = Dir()
   Loop
End Sub

 

[_eNVy_]

Hi Fluff,

When going through the code line by line, it gets up to

 Do While Fname <> ""

and then goes straight to End Sub.

 

[_eNVy_]

Hi Mohadin,

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

Hi
you can use

On Error Resume Next

 

[Fluff]

Oops missed an *, it should be

   Fname = Dir(Pth & "[COLOR=#ff0000]*[/COLOR].xls*")

I would also strongly recommend against adding

On Error Resume Next

unless absolutely necessary, as it can lead to all sorts of problems.

 

[_eNVy_]

Thank you Fluff - your code works, however, when pasting

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

It pastes over the last cell of data in that column and the data being pasted thereafter goes over all data in that column except for Row 2.

And although the AutoFill has been bypassed, if there is a single line of data, range

ws.Range("D3").Value

Doesn't seem to get pasted next to the single line of entry.

Hope this makes sense?

 

[Fluff]

It all works perfectly for me, so it must be something to do with your data.
Will column D on every sheet being copied have data on every row?

 

[_eNVy_]

No.

The TimeSheet file(s) will have months per tab.
But they wouldn't have done any "work" in those future months (yet).

Every sheet will have the same D3 information (or should - this D3 cell has the name of the employee - should always be the same).
Range C17:G33 may not have any data in it.

Just a thought. Is there a way to paste data that ranges every 19 rows instead of having

wsData.Range("A" & Rw & ":A" & wsData.Range("D" & Rows.Count).End(xlUp).Row).Value

Just thinking it may solve the problem?

 

[Fluff]

Do you just want the name in the first row for each sheet? or all 17 rows regardless of how much data is pulled over?