Insert Column then insert designated number

-Delete first 6 rows in the spreadsheet

rows("1:6").entirerow.delete

-Delete all of the rows following the last name entry
How is this determined?

-Insert a column
where? this will insert a column to the left to the E column (creates a new E column)

columns(5).insert

-Title the column "Week"
Range("E1")="Week"

-Allow the user to identify the week number

strWeek = Application.Inputbox ("Week number Please")

-Copy that number down the column

Range("e1:E10")=strWeek

If you upload a sample workbook, I can add the code that does what you've asked above, including making the week number entry dynamic.

Attached is a test book that displays the basic format of the spreadsheet I am working on.

Again the steps I am trying to complete are:

-Delete first 6 rows in the spreadsheet
-Delete all of the rows following the last name entry
-Insert a column between column A and B to become the new second column
-Title the column "Week"
-Allow the user to identify the week number
-Copy that number down the column

Hopefully this clarifies things a bit more. Thanks again for your help!

What does this mean?
-Delete all of the rows following the last name entry
Is that everything from row 19 (of the unedited versionof the book you posted) to the bottom of the sheet?

Correct, I need the macro to delete all the rows following the last "Agent Name" in row 18. The catch is though, they may add a few agents so there would be more rows. So while this week everything after row 18 needs to be deleted, next week it may be all the rows following row 21. Does that make sense? Thanks again.

It worked! Thank you so much!

I just remembered one more wrinkle to throw in there. This Macro will need to be run on 2 different tabs (tab 3 and tab 13) in a workbook containing a total of 13 tabs. How do I specify that I need it to run on only those 2 tabs?

If my previous assumption is correct, try this.

Sub doStuff()
    Dim bRow As Long, strWeek As String

    Rows("1:6").EntireRow.Delete
    bRow = Cells(1, 1).End(xlDown).Row
    Rows(bRow + 1 & ":" & Rows.Count).EntireRow.Delete
    Columns(2).Insert
    Range("B1") = "Week"
    strWeek = Application.InputBox("Week please")
    Range("b2:b" & bRow) = strWeek

End Sub

The following assumes the same week will be used for both sheets.

Sub doStuff()
    Dim bRow As Long, strWeek As String, i As Integer
For i = 3 To 13 Step 10
    strWeek = Application.InputBox("Week please")
With Sheets(i)
    .Rows("1:6").EntireRow.Delete
    bRow = Cells(1, 1).End(xlDown).Row
   .Rows(bRow + 1 & ":" & Rows.Count).EntireRow.Delete
    .Columns(2).Insert
   .Range("B1") = "Week"
   .Range("b2:b" & bRow) = strWeek
End With
Next
End Sub

I tried the Macro but for some reason it didn't work. When I selected to Run it I got the prompt to identify the week but for some reason it didn't do anything afterwards. I simply cut and pasted it into the VBA coder. Was this the correct step to take or did I possibly do something incorrectly?

It should work as posted - with the annoyance of being prompted twice for the week number. The version will only ask once. Make sure you are pasting it into a standard module and not a sheet module in the VBE.

Sub doStuff()
    Dim bRow As Long, strWeek As String, i As Integer
strWeek = Application.InputBox("Week please")
For i = 3 To 13 Step 10
With Sheets(i)
    .Rows("1:6").EntireRow.Delete
    bRow = Cells(1, 1).End(xlDown).Row
   .Rows(bRow + 1 & ":" & Rows.Count).EntireRow.Delete
    .Columns(2).Insert
   .Range("B1") = "Week"
   .Range("b2:b" & bRow) = strWeek
End With
Next
End Sub

I went back and tried it again and it still didn't work. I then went back and tried the first macro you created and it worked correctly. Could there be something in the top part of the code which identifies the Tabs to modify that could be the problem?

The code first runs against sheet 3 then sheet 13 in this part

For i = 3 To 13 Step 10
With Sheets(i)

Can you post the complete book? (sanitized if there is information you don't want to.cannot share).

Attached is an expanded version of the sheet I attached earlier. It is a good representation of the actual workbook. Thanks for your patience! It is greatly appreciated.

Try this version - You can specify the sheet names to run the macro against in this line

If Sheets(i).Name = "Sheet3" Or Sheets(i).Name = "Sheet13" Then

Sub doStuff()
Dim bRow As Long, strWeek As String, i As Integer
strWeek = Application.InputBox("Week please")
For i = 1 To Sheets.Count
If Sheets(i).Name = "Sheet3" Or Sheets(i).Name = "Sheet13" Then
With Sheets(i)
    .Rows("1:6").EntireRow.Delete
    bRow = Cells(1, 1).End(xlDown).Row
   .Rows(bRow + 1 & ":" & Rows.Count).EntireRow.Delete
    .Columns(2).Insert
   .Range("B1") = "Week"
   .Range("b2:b" & bRow) = strWeek
End With
End If
Next
End Sub

I've updated your workbook with one change. Sheet3 did not have the tables. I also updated the macro to correctly calculate the number of agents in the list. The workbook has not had the macro run against it.
The new code

Sub doStuff()
Dim bRow As Long, strWeek As String, i As Integer
strWeek = Application.InputBox("Week please")
For i = 1 To Sheets.Count
If Sheets(i).Name = "Sheet3" Or Sheets(i).Name = "Sheet13" Then
With Sheets(i)
    .Rows("1:6").EntireRow.Delete
    bRow = Sheets(i).Cells(1, 1).End(xlDown).Row
   .Rows(bRow + 1 & ":" & Rows.Count).EntireRow.Delete
    .Columns(2).Insert
   .Range("B1") = "Week"
   .Range("b2:b" & bRow) = strWeek
End With
End If
Next
End Sub

It worked!!! Thank you so much!

One more question for you. Do you know of a way to remove the special characters from the names in row 1? I've trying to look for a way to remove all of the periods but have yet to come by a solution.

Thanks again!