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
<tbody>
</tbody>
Expected Spreadsheet
<tbody>
</tbody>
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.
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
Recipient | Email Address | Comment |
<tbody>
</tbody>
Expected Spreadsheet
Recipient | Email Address | Comment | Worksheet Name |
<tbody>
</tbody>
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.