Loop Macro. Prompt input.

[Poco90]

Hi,
I have several hundred workbooks with multiple worksheets(15-35) that I am trying to tidy up, so the data can be entered into a database. Its my first attempt at VBA and between the forum and macro recorder I made an attempt which is below. I just can't seem to get over the last part. I have searched the forum but can't seem to find any relevant information. I have a couple of questions.


1. I need to be able to run this macro over all the worksheets in the workbook, so how can I loop it? All the worksheets are named differently i.e. peoples names.

2. In my code I have inserted 4 columns. These columns will be the only thing common between all the worksheets. A1 to A30 = Week number, B1 to B30 = Shift Number, C1 to C30 = Supervisor number. Column D is blank. I'd like to be able to be prompted to enter these 3 numbers at the start if possible? Can this be done in such a way as you are only prompted the once and not on each worksheet? I picked 30 rows because the amount of rows in each worksheet varies but never exceeds this. The end of my code "Delete rows where cell B is blank" will delete any excess data where 30 rows of week numbers etc are not needed.

Thanks in advance,
Poco


Sub CleanCost1_1()
'
' CleanCost1_1 Macro
' Macro recorded 04/09/2009
'

' Delete Job Card Sheet
Sheets("Job Card").Select
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
' Delete Master Sheet
Sheets("Master").Select
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
' Delete Rows 1 to 26
Rows("1:26").Select
Selection.Delete Shift:=xlUp
'Select All cells Zoom 100 and remove grid
Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveWindow.Zoom = 100
'Move row E to A
Columns("E:E").Select
Selection.Cut
Columns("A:A").Select
ActiveSheet.Paste
'Insert 4 Columns
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Range("F27").Select
'Delete rows where cell B is blank
Dim LR As Long
LR = Cells.Find("*", searchdirection:=xlPrevious, SearchOrder:=xlByRows).Row
On Error Resume Next
Range("B1:B" & LR - 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub

 

[Poco90]

Guys, thanks for your help. I have nearly my macro sorted to do one XLS file at a time. This will do me as it will save me hours of work. Thanks again.

Poco