Copying certain cells from changing amount of worksheets to new rows

Question

I have a number of Worksheets which track projects. All of these worksheets follow the same formatting and layout. More of these worksheets are created on a weekly basis. So there is 5 at the moment but there will be many more in the future.

I am looking create a master worksheet which uses a certain cells to summerise the key points from the worksheets.

For example For each (sheet1, sheet2, sheet3 etc...) I need the same data which is on the same cells across sheets. The data goes from cells H13:H18, H20:H28, and H30:48. I need to pull this data of the to master sheet where it will be divided by the number of cells to give me a percentage. Once this has been done along the same row in "Sheet1" it will move to the next sheet ("Sheet2") and copy the data to the next row of the master sheet.

So far this is what I have come up with, total beginner:

Dim lastRow As Long
Dim wb As Workbook
Set themaster = Sheets("Master")
Set wb = Application.Workbooks("workb1")

For i = 1 To wb.Sheets.Count
    wb.Sheets(i).Activate
    Sheet.Range("C4", "H13:H18", "H20:H28", "H30:H48").Select
    Selection.Copy

lastRow = themaster.Range("A" & themaster.Rows.Count).End(xlUp).Row

With Selection
    .Copy Destination:= themaster.Range("A" & lastRow + 1)
    .EntireRow.Delete
End With
Next

I dont really know how to progress. Not sure how to get the data to be pasted along the row and how to insert it as a part of a formula. Also unsure how to keep this automated so as new worksheets are completed this can be re run and the master sheet up-dated.

Any help would be greatly appreciated.

Depending on what you're doing, it's possible you can accomplish this without VBA. Using the AVERAGE formula, for example, can work across sheets (including an unknown number of sheets). Look at this site and this site — PeterT
I would use a For Each Worksheet in Worksheets loop. Don't worry about your average right away. One problem at a time (first learn how to loop through your sheets and copy/paste) — urdearboy

urdearboy urdearboy · Accepted Answer · 2018-08-07T02:25:59

This will help you get started. It loops through every sheet, transposes the data you want into a new row on Master, and will currently average all of the data at the end (Column Z, as your desired ranges span Columns A to AA once transposed). Once ran, you can see the formula that is produced on your Master sheet.

Option Explicit

Sub akdjhfgaerfjslrhlvs()

Dim Master As Worksheet: Set Master = ThisWorkbook.Sheets("Master")
Dim ws As Worksheet, LRow As Long

Application.ScreenUpdating = False
    For Each ws In Worksheets
        If ws.Name <> Master.Name Then
            With Master
                LRow = .Range("A" & .Rows.Count).End(xlUp).Offset(1).Row   'Find Last Row
                .Range("A" & LRow) = ws.Range("C4") 'Grab cell C4
                Union(ws.Range("H13:H18"), ws.Range("H30:H48")).Copy 'Copy the others at once
                .Range("B" & LRow).PasteSpecial xlPasteValues, Transpose:=True 'Paste/transpose at once

                .Range("AA" & LRow).Formula = "=Average(A" & LRow & ":" & "Z" & LRow & ")" 'average all the data at once

            End With
        End If
    Next ws
Application.ScreenUpdating = True

MsgBox "Please show an attempt on your next post. You should also take the tour page if you intend to keep Stack Overflow as a future resource", vbCritical

End Sub

You can have this fire off using Events like when a workbook is opened/closed/saved/etc. Which one to use really depends on your situation and you have not given enough info for anyone to provide a decent suggestion.

Copying certain cells from changing amount of worksheets to new rows

1 Answers