Autofill column with data from other sheet

[MarqyMarq]

Hello. Would appreciate any help. I have a workbook that has multiple sheets with similar data in each sheet. For this problem, let’s presume there is a cell (A1) that contains the TITLE for each sheet, and a group of information that needs to be captured (G4:K?)(ranging from 32-65 rows). Both the TITLE and grouped data needs to be copied and pasted (values) into a separate “Summary” sheet. This needs to happen for all sheets in the workbook.

I have the code for the grouped data, but I cannot seem to figure out how to autofill column A with the Title for all the row values for each group of data (between 32 – 65 rows).

Okay, so here’s what I would like the Summary sheet to be:

In column A, it will contain the Title. (need the code for this part)(I’m thinking “AutoFill”)
Column B – G, will contain the grouped data. (This code works!)

Title	Task	POC	Days	Start Date	Revised Date	Complete Date
Title 1 - A1	Task A	Mike	6	etc	etc	etc
Title 1 - A1	Task B	Ralph	3	etc	etc	etc
Title 1 - A1	Task C	Kristen	4
Title 1 - A1	Task D	Kirk	6
Title 2 - A1	Task A	John	6
Title 2 - A1	Task B	Kirk	3
Title 2 - A1	Task C	Joe	4
Title 2 - A1	Task D	Kristen	6
Title 3 –A1	Task A	Mike	6

<tbody>
</tbody>

Here's my code to move the group data from several sheets to the Summary sheet:

---

Sub MakeSummary()​

​

On Error Resume Next​

​

Dim ws As Worksheet​

Dim rc As Integer ' rc is row count​

'Screen does not update from changing sheets​

Application.ScreenUpdating = False​

'Clears the contents of Summary Sheet​

Sheets("Summary").Activate​

rc = Sheets("Summary").Range("C" & Rows.Count).End(xlUp).Row​

Sheets("Summary").Range("A3:F" & rc).ClearContents​

MsgBox ("Deleted " & rc & " rows"), vbDefaultButton2​

'Copy contents from worksheets to Summary sheet​

For Each ws In Worksheets​

If ws.Name <> "Holidays" And ws.Name <> "Summary" And ws.Name <> "Table of Contents" And ws.Name <> "Master" Then​

With ws​

'Code below determines the number of rows in column J and uses that number in the next line of code​

rc = ws.Range("J" & Rows.Count).End(xlUp).Row​

ws.Range("G4:K" & rc).Copy​

ActiveSheet.Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues​

​

'this section of code autofills column A with Title name​

' Here's where I think the autofill code should go)​

End With​

End If​

Next ws​

​

'Sets cursor at TOP Left of screen​

Range("A1").Select​

End Sub

---

I hope you folks can help me! I've been pulling my hair out!

Thanks!​

 

[MarqyMarq]

Any help on this one???