Hi
Your macro is comparing af fixed cell in the loop (C60), use a variable to
hold the cell to compare. Also I would use a Case Select structure rather
than IF..Then...Else
Give this a try:
Sub Test1()
Dim x As Integer
Dim Criterium As Range
' Set numrows = number of rows of data.
NumRows = Range("B60", Range("B60").End(xlDown)).Rows.Count
Set Criterium = Range("C60")
' Select cell B601.
'Range("B60").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows - 1
Select Case Criterium
Case Is = "A"
Sheets("Template A").Copy Befo=Sheets("End")
Sheets("Template A (2)").Name = "A" & Format(x, "000")
Case Is = "B"
Sheets("Template B").Copy Befo=Sheets("End")
Sheets("Template B (2)").Name = "B" & Format(x, "000")
Case Is = "C"
Sheets("Template C").Copy Befo=Sheets("End")
Sheets("Template C(2)").Name = "C" & Format(x, "000")
Case Is = "Detail"
Sheets("Template D").Copy Befo=Sheets("End")
Sheets("Template D (2)").Name = "D" & Format(x, "000")
Case Is = ""
Sheets("Template E").Copy Befo=Sheets("End")
Sheets("Template E (2)").Name = "E" & Format(x, "000")
End Select
Set Criterium = Criterium.Offset(1, 0)
Next
End Sub
Regards,
Per
"Andy_N1708 via OfficeKB.com" <u40722@uwe skrev i meddelelsen
news:a88d0cde22da3@uwe...
Hello all,
I have written a macro that looks at one column of text and depending on
what
is in the cell of that column, the macro would copy a template worksheet.
The
macro works for the first cell in the column but then it defaulted back to
the last condition. I cannot get it to work correctly and hoping you guys
can
give me some pointers. Below is the code for the macro...I appreciate the
help. Thanks.
Sub Test1()
Dim x As Integer
' Set numrows = number of rows of data.
NumRows = Range("B60", Range("B60").End(xlDown)).Rows.Count
' Select cell B601.
Range("B60").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows - 1
If Range("C60").Value = "A" Then
Sheets("Template A").Copy Befo=Sheets("End")
Sheets("Template A (2)").Name = "A" & Format(x, "000")
ElseIf Range("C60").Value = "B" Then
Sheets("Template B").Copy Befo=Sheets("End")
Sheets("Template B (2)").Name = "B" & Format(x, "000")
ElseIf Range("C60").Value = "C" Then
Sheets("Template C").Copy Befo=Sheets("End")
Sheets("Template C(2)").Name = "C" & Format(x, "000")
ElseIf Range("C60").Value = "Detail" Then
Sheets("Template D").Copy Befo=Sheets("End")
Sheets("Template D (2)").Name = "D" & Format(x, "000")
ElseIf Range("C60").Value = "" Then
Sheets("Template E").Copy Befo=Sheets("End")
Sheets("Template E (2)").Name = "E" & Format(x, "000")
ActiveCell.Offset(1, 0).Select
End If
Next
End Sub
--
Message posted via http://www.officekb.com