Macro to Add Column on Multiple Tabs to represent Sheet Name

[ShanaVT]

I have multiple tabs in a workbook all with the same type of data but for different weeks. I need a macro to insert a column at the beginning of the data and create a column A with the heading "Week" that will fill in the whole column down to the last row with data with the worksheet name. It will be varying amounts of sheets in each file but I will need it to insert this column on all sheets after Sheets 1-3. So I think the best way would be for the macro to have a prompt asking me which Sheets and then I would select the Sheets I need the columns added. Below is the same data.

Current Data:

Recipient ID	Donation Date (UTC)	Amount
2272	2018-07-09 13:05:31 UTC	10
2272	2018-07-09 13:16:56 UTC	25
2272	2018-07-09 13:17:00 UTC	25
2272	2018-07-10 02:20:07 UTC	50
2272	2018-07-10 04:56:07 UTC	25

<tbody>
</tbody>

Data Needed - Sheet Name is "20180926"

Week	Recipient ID	Donation Date (UTC)	Amount
20180926	2272	2018-09-17 13:05:39 UTC	10
20180926	2272	2018-09-17 13:09:20 UTC	10
20180926	2272	2018-09-17 13:09:27 UTC	10
20180926	2272	2018-09-17 13:10:37 UTC	15
20180926	2272	2018-09-17 13:10:40 UTC	200

<tbody>
</tbody>

Thank you!

 

[DanteAmor]

In the execution of the macro you can indicate the initial sheet number.

Sub Add_Column()
'
    Dim n As Variant, h As Integer, u As Long
    Application.ScreenUpdating = False
    n = InputBox("Initial Sheet : ", "ADD COLUMN", 1)
    If n = "" Or n < 1 Or Not IsNumeric(n) Then
        Exit Sub
    End If
    '
    For h = n To Sheets.Count
        u = Sheets(h).Range("A" & Rows.Count).End(xlUp).Row
        Sheets(h).Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheets(h).Range("A1:A" & u) = Sheets(h).Name
    Next
    MsgBox "End"
End Sub

Regards Dante Amor

 

[ShanaVT]

This works great! Thank you! The only question I have is if it is possible for the value in cell A1 to have the header "Week" instead of the Sheet name like the rest of the column.

 

[DanteAmor]

Sub Add_Column()
'
    Dim n As Variant, h As Integer, u As Long
    Application.ScreenUpdating = False
    n = InputBox("Initial Sheet : ", "ADD COLUMN", 1)
    If n = "" Or n < 1 Or Not IsNumeric(n) Then
        Exit Sub
    End If
    '
    For h = n To Sheets.Count
        u = Sheets(h).Range("A" & Rows.Count).End(xlUp).Row
        Sheets(h).Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheets(h).Range("A1:A" & u) = Sheets(h).Name
        Sheets(h).Range("A1").value = "Week"
    Next
    MsgBox "End"
End Sub