Looping dose not work in Excel

[amy0299]

Hi, I am new to this forum and also this is my first Excel VBA. I have multiple work sheets in the same workbook with the same columns but different number of rows. I want to add 5 more columns to each worksheet and also populate those columns.
The script is adding columns and populating cells correctly ONLY on the first worksheet. The looping is not working. Below is the script. Any Suggestion / correction is greatly appreciated. Thanks in advance for all your help!

Sub add_cell()


Dim wrk As Workbook
Dim WS As Worksheet


Set wrk = ActiveWorkbook


For Each WS In wrk.Worksheets
If WS.Index = wrk.Worksheets.Count Then
Exit For
End If

Columns("A:E").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Value = "Date"
Range("A2").Value = Format(Now(), "mm-dd-yyyy")

Range("B1").Value = "Month"
Range("B2").Value = Format(Now(), "MMM")

Range("C1").Value = "Tab"
Range("C2").Value = ActiveSheet.Name

Range("D1").Value = "Name"
Range("D2").FormulaR1C1 = "=CONCATENATE(RC[2],"" "",RC[3])"

Range("E1").Value = "Type"
Range("E2").FormulaR1C1 = "=IF(LEFT(RC[-1],3)=""syn"",""Sync"", ""Non Sync"")"

Range("A2:E2").Select
Selection.Copy

With WS
.Range("A2:E" & .Cells(Rows.Count, "F").End(xlUp).Row).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Range("A2:E" & .Cells(Rows.Count, "F").End(xlUp).Row).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End With


Exit For
Next WS



End Sub

 

[patel45]

eliminate Exit For before Next WS

 

[amy0299]

Works like a charm. Thank you so much for your help and quick response.