worksheet loop
Public Sub Processteams()
Dim iLastRow As Long
Dim i As Long
Dim iCol As Long
Dim iRow As Long
Dim sh as Worksheet
for each sh in Worksheets
if sh.Name < "Sheet1" and sh.Name < "Sheet2" then
with sh
.Rows("1:300").Insert Shift:=xlToRight
iLastRow = .Cells(.Rows.Count, "o").End(xlUp).Row
For i = 1 To iLastRow
iCol = 0
On Error Resume Next
iCol = Application.Match(.Cells(i, "o").Value, _
.Rows(1), 0)
On Error GoTo 0
If iCol = 0 Then
iCol = .Range("a1").End(xlToRight).Column + 1
If iCol .Columns.Count Then
iCol = IIf(.Range("a1").Value = "", 1, 2)
End If
.Cells(1, iCol).Value = .Cells(i, "o").Value
iRow = 2
.Cells(1, iCol).Interior.ColorIndex = 37
Else
iRow = .Cells(1, iCol).End(xlDown).Row + 1
End If
.Cells(iRow, iCol).Value = .Cells(i, "c").Value
Next i
End With
End if
Next sh
End Sub
--
Regards,
Tom Ogilvy
"Sjakkie" wrote:
how can i adapt the following script to run on all worksheets in a workbook
but to ignore and go to the next sheet if the sheet name equals "Sheet1" or
"Sheet2"
Public Sub Processteams()
Dim iLastRow As Long
Dim i As Long
Dim iCol As Long
Dim iRow As Long
With ActiveSheet
Rows("1:300").Insert Shift:=xlToRight
iLastRow = .Cells(.Rows.Count, "o").End(xlUp).Row
For i = 1 To iLastRow
iCol = 0
On Error Resume Next
iCol = Application.Match(.Cells(i, "o").Value, _
ActiveSheet.Rows(1), 0)
On Error GoTo 0
If iCol = 0 Then
iCol = ActiveSheet.Range("a1").End(xlToRight).Column + 1
If iCol .Columns.Count Then
iCol = IIf(ActiveSheet.Range("a1").Value = "", 1, 2)
End If
ActiveSheet.Cells(1, iCol).Value = .Cells(i, "o").Value
iRow = 2
ActiveSheet.Cells(1, iCol).Interior.ColorIndex = 37
Else
iRow = ActiveSheet.Cells(1, iCol).End(xlDown).Row + 1
End If
ActiveSheet.Cells(iRow, iCol).Value = .Cells(i, "c").Value
Next i
End With
End Sub
|