Consolidate worksheets & copy the name of the tab in a column

[boonlecxe]

Hello,

I am trying to consolidate a spreadsheet with 45 worksheets. I want to copy all the data into one worksheet and call it master.
I also need to copy the name of the worksheet next to the data in a separate column.

I have three columns:

1) Recipient
2) Email Address
3) Comments

the macro should create a code to pull the name of the worksheet and put it in a fourth column.
I have attached screenshots to better explain my requirement.

A search through the forum gave me code to consolidate data from different worksheets, however i also need to be able to copy the name of the worksheet in the column.


CURRENT Spreadsheet


[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Recipient[/TD]
[TD]Email Address[/TD]
[TD]Comment[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]









Expected Spreadsheet


[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Recipient[/TD]
[TD]Email Address[/TD]
[TD]Comment[/TD]
[TD]Worksheet Name[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]







Here is the code i used to consolidate the data.

Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Master" And Sht.Range("A2").Value <> "" Then
Sht.Select
LastRow = Range("A65536").End(xlUp).Row
Range("A2", Cells(LastRow, "M")).Copy
Sheets("Master").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Sht.Select
Range("A2", Cells(LastRow, "M")).ClearContents
Else
End If
Next Sht




End Sub



Thank you for the help.

 

[venkat1926]

I have slightly modified your macro and added an undo macro
run undo macro first and then your macro
it is not necessary to select each sheet or cell(s) to be copied and to be pasted. you can use with and end with
if you use with
dot is subequent coe

Sub CombineData()
Dim Sht As Worksheet, LastRow As Integer, shname As String, dest As Range


For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Master" And Sht.Range("A2").Value <> "" Then
'Sht.Select
With Sht
shname = .Name
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Range(.Range("A2"), .Cells(LastRow, "C")).Copy     ' why M why not C az there are only 3 colmns
With Sheets("Master")


Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest.PasteSpecial


.Cells(dest.Row, "D") = shname


'ActiveSheet.Paste
'Sht.Select
'Range("A2", Cells(LastRow, "M")).ClearContents
End With


End With
End If
Next Sht
End Sub

Sub undo()
Worksheets("master").Cells.Clear
End Sub

 

[boonlecxe]

thank you for your help. The code works like a charm !!

 

[venkat1926]

you are welcome . study some more about "with......end with"

 

[boonlecxe]

Hello, I have a followup question can i automate this process ?
everytime i add a new tab the data should automatically be copied into the master sheet.

 

[boonlecxe]

An update to the question i posted above,

I tried using the below code.


Private Sub Workbook_Open()'Run YourSub at 6pmApplication.OnTime TimeValue("18:00:00"), "YourSub"End SubI changed the time to my current time plus 5 minutes & changed the name of the macro and saved the code to thisworkbook module. the macro doesnt run , can any one offer me any suggestions to troubleshoot it ?</pre>

 

[venkat1926]

another method is
1. open the file
2.introduce new sheet with data
3. sun write a event code
4. you have to thing of event with whic a code will be run to copy the new sheet to matersheet
5. i suggest THE EVENT MAY BE - doubleclick A1 of the just created new sheet
6. can you write an event code (double clicking active sheet
check in the web about

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)


End Sub

you have to try some expleriments and test them.

this will be a good exercise for you.

also wait for some expert to give better ideas