VBA Help - Loop thru an array of Sheets in Workbook and extract first row to a Log Sheet

[Johnny Thunder]

Hi everyone!

I am stuck on a task that I am not sure how to accomplish but it is pretty straightforward. My workbook has several sheets that I can put into an array that I want to extract only the first row of data E4:V4 and paste these values into Sheets("Daily Log") starting in the same range of E4:V4 and just move down the sheet based on how many tabs there.

In a nutshell, I have several sheets with itemized detail, this "Daily Log" serves as a quick snapshot to only show the latest activity from that specific sheet which happens to always be the first row in the report.

Code Steps Needed:
1. Wipe the old Data Clear, Sheets("Daily Log").Range("E4:V" & Lastrow).ClearContents
2. Identify how many sheets need to have data extracted - It will be easier to just identify the sheets to not loop thru than to always add new sheets to the array.

2a. Sheets to not Loop Thru: "Control Sheet", "Daily Log", "Lookups"​

3. Loop thru each sheet and if there is data in Row 4, Extract that row using range (E4:V4) and paste in the Daily Log
4. Move one row down on the daily log for the next sheets data
5. End Loop and now your done.

If anyone has any ideas I would appreciate it! Thanks!

​

 

[jolivanes]

Do you have data in the first 3 rows from Column E to V?

 

[Johnny Thunder]

No, there are headers and some non-essential pieces of data like the users name, timestamp of when the file was last updated etc.

 

[jolivanes]

Don't know if this works on a Mac.

Sub Maybe()
Dim sh1 As Worksheet, ws As Worksheet
Set sh1 = Sheets("Daily Log")
sh1.Range("E1:V" & sh1.Cells(Rows.Count, 5).End(xlUp).Row).Offset(3).ClearContents
    For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
            Case "Control Sheet", "Daily Log", "Lookups"
                Case Else
                    If Len(ws.Cells(4, 5)) <> 0 Then
                        sh1.Cells(Rows.Count, 5).End(xlUp).Offset(1).Resize(, 18).Value = ws.Cells(4, 5).Resize(, 18).Value
'                        or the following should work also
'                        ws.Cells(4, 5).Resize(, 18).Copy sh1.Cells(Rows.Count, 5).End(xlUp).Offset(1)
                    End If
        End Select
    Next ws
End Sub

 

[Johnny Thunder]

That worked great! And yes, it worked on a Mac.

 

[jolivanes]

Thanks for the feedback and good luck.