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

lars_mn

New Member
Joined
Oct 5, 2015
Messages
24
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
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
How about
Code:
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
 
Upvote 0
Glad to help & thanks for the feedback

Seasons greetings
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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