VBA to create overview of multiple identical sheets with different content in cells

[lars_mn]

I have an Excel spreadsheet with multiple sheets with same layout, but with different content in some of the cells on the sheets. The cells that have different content on each sheet have the same location on each sheet.
I would like a macro that creates a table (overview) with the contents of the cells from each sheet. The table could look something like this:
[TABLE="width: 653"]
<tbody>[TR]
[TD]Set
[/TD]
[TD]Drawing
[/TD]
[TD]Checked
[/TD]
[TD]Cleaned
[/TD]
[TD]Packed
[/TD]
[TD]Checked
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[/TR]
</tbody>[/TABLE]

I have attached a link below to the spreadsheet which contains the “Template” that will exist in many copies but with different checkmarks. In the spreadsheet I have made a sheet called “Overview” which I think holds the pattern and explanation of what the macro should do. Only I need someone to change it to a smart VBA language.

https://www.dropbox.com/s/ob4o9e2jbok0zhj/Control%20of%20insulated%20parts.xlsm?dl=0

 

[Fluff]

How about

Sub PopulateOverview()

   Dim Ovr As Worksheet
   Dim Ws As Worksheet
   Dim Col As Long
   Dim Rw As Long
   Dim NxtCol As Long
   Dim NxtRw As Long
   
Application.ScreenUpdating = False

   Set Ovr = Sheets("Overview")
   NxtRw = 2
   
   For Each Ws In Worksheets
      If Not Ws.Name = Ovr.Name Then
         For Rw = 1 To Ws.Range("A" & Rows.Count).End(xlUp).Row Step 18
            NxtCol = 2
            For Col = 1 To Ws.Cells(1, Columns.Count).End(xlToLeft).Column Step 4
               Ovr.Range("A" & NxtRw).Value = Ws.Name
               Ovr.Cells(NxtRw, NxtCol).Value = Ws.Cells(Rw, Col).Value
               Ovr.Cells(NxtRw, NxtCol + 1).Resize(, 3).Value = Ws.Cells(Rw + 15, Col).Resize(, 3).Value
               Ovr.Cells(NxtRw, NxtCol + 4).Value = Ws.Cells(Rw + 16, Col)
               NxtRw = NxtRw + 1
            Next Col
         Next Rw
      End If
   Next Ws
   
End Sub

 

[lars_mn]

Looks like its working. Thanks and merry xmas

 

[Fluff]

Glad to help & thanks for the feedback

Seasons greetings