Copy Data from multiple sheets to Main datasheet

Hi Bogleda,

Here's one to load your Table of Context:

Sub Bogleda(): Dim wt As Worksheet, ws As Worksheet, t As Long, r As Long, i As Long, D
Set wt = Sheets("Table of Context"): t = wt.Range("A" & Rows.Count).End(xlUp).row + 1
For Each ws In Worksheets
If ws.Name = wt.Name Or ws.Name = "CONVERSIONS" Or ws.Name = "DropDown Menus" Then GoTo GetNext
r = 4: Do Until ws.Range("A" & r) = "": r = r + 1: Loop
D = ws.Range(ws.Cells(4, 1), ws.Cells(r, 6)): r = r - 4
For i = 1 To r: D(i, 6) = ws.Name: Next i
wt.Range(wt.Cells(t, 1), wt.Cells(t + r, 6)) = D
t = t + r
GetNext: Next
End Sub

I'm thinking about the change event code now

Here's a start! F-S886 (Material Properties Database).xls

And - Welcome to the forum

Hi Bogleda,

Just in case you want to change the Number:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
                Set Sh = ActiveSheet
If Sh.Name = "Table of Context" Or Sh.Name = "CONVERSIONS" Or _
Sh.Name = "DropDown Menus" Then Exit Sub
If Target <> "" And Target.Column < 6 Then
Dim wt As Worksheet, X As String, FN As String, F As Range, D, r As Long
Set wt = Sheets("Table of Context"):  r = Target.Row: X = Cells(r, 1)
If Target.Column = 1 Then X = Cells(r, 2)
D = Range(Cells(r, 1), Cells(r, 6)): D(1, 6) = Sh.Name
Set F = wt.Range("A:B").Find(X)
If Not F Is Nothing Then
Application.EnableEvents = False
wt.Range(wt.Cells(F.Row, 1), wt.Cells(F.Row, 6)) = D
Application.EnableEvents = True
End If: End If: End Sub

Hi Bogleda,

The change code is included in the attachment - will the A column entry ever be changed?

You're welcome and thanks for the rep!

Hi Bogleda,

Can I add line items (Rows) to the existing info datasheets that will copy over to the TOC?

Can I add info datasheets to the workbook and would they be included with the copy code?

You'd have to disable events and rerun the :Bogleda for that

Can the conditional formatting be copied with the data to the TOC?

The program would have to be rewritten to transfer the Conditional Formatting

I used "Writing Excel Macros" - O'Reilly by Steven Roman
and I bought "Excel 2003 Power Programming with VBA" by John Walkenbach.

But we have a Tips and Tutorials Forum with many good suggestions

Hi Bogleda,

This should get your CF:

Sub Bogleda2(): Dim wt As Worksheet, ws As Worksheet, t As Long, r As Long, i As Long, D As Range
Application.EnableEvents = False: t = 3: Set wt = Sheets("Table of Context"): wt.Activate
wt.Range(Cells(t, 1), wt.Cells(Rows.Count - t, 1)).EntireRow.Clear
For Each ws In Worksheets
If ws.Name = wt.Name Or ws.Name = "CONVERSIONS" Or ws.Name = "DropDown Menus" Then GoTo GetNext
r = 4: Do Until ws.Range("A" & r) = "": r = r + 1: Loop: r = r - 1
For i = 4 To r: ws.Cells(r, 6) = ws.Name: Next i
Set D = ws.Range(ws.Cells(4, 1), ws.Cells(r, 6)): r = r - 3
D.Copy wt.Range("A" & t)
t = t + r: wt.Columns.AutoFit: wt.Rows.AutoFit
GetNext: Next: Application.EnableEvents = True: End Sub

And - when you're building the full book, you could just Change the name of the event code in the ThisWorkbook module:

Private Sub XWorkbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
                Set Sh = ActiveSheet
If Sh.Name = "Table of Context" Or Sh.Name = "CONVERSIONS" Or _
Sh.Name = "DropDown Menus" Then Exit Sub
If Target <> "" And Target.Column < 6 Then
Dim wt As Worksheet, X As String, FN As String, F As Range, D, r As Long
Set wt = Sheets("Table of Context"):  r = Target.Row: X = Cells(r, 1)
If Target.Column = 1 Then X = Cells(r, 2)
D = Range(Cells(r, 1), Cells(r, 6)): D(1, 6) = Sh.Name
Set F = wt.Range("A:B").Find(X)
If Not F Is Nothing Then
Application.EnableEvents = False
wt.Range(wt.Cells(F.Row, 1), wt.Cells(F.Row, 6)) = D
Application.EnableEvents = True
End If: End If: End Sub