Ignore Hidden Sheet & AutoFill Fail Safe

_eNVy_

Board Regular
Joined
Feb 9, 2018
Messages
66
Office Version
  1. 365
Platform
  1. Windows
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?

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.


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
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
How about
Code:
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
 
Upvote 0
Solution
Hi Fluff,

When going through the code line by line, it gets up to
Code:
 Do While Fname <> ""
and then goes straight to End Sub.
 
Upvote 0
Oops missed an *, it should be
Code:
   Fname = Dir(Pth & "[COLOR=#ff0000]*[/COLOR].xls*")
I would also strongly recommend against adding
Code:
On Error Resume Next
unless absolutely necessary, as it can lead to all sorts of problems.
 
Upvote 0
Thank you Fluff - your code works, however, when pasting

Code:
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
Code:
ws.Range("D3").Value
Doesn't seem to get pasted next to the single line of entry.

Hope this makes sense?
 
Last edited:
Upvote 0
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?
 
Upvote 0
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
Code:
wsData.Range("A" & Rw & ":A" & wsData.Range("D" & Rows.Count).End(xlUp).Row).Value

Just thinking it may solve the problem?
 
Last edited:
Upvote 0
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?
 
Upvote 0

Forum statistics

Threads
1,213,583
Messages
6,114,495
Members
448,575
Latest member
hycrow

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top