Help with macro

[Beekman]

Option Explicit

Public Sub CopyBlockTwice()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Dim ws5 As Worksheet
Dim ws6 As Worksheet
Dim iLastRow As Long
Dim iRow As Long
Dim iOutRow As Long

Set ws1 = ThisWorkbook.Sheets("HEADER")
Set ws2 = ThisWorkbook.Sheets("MONDAY")
Set ws3 = ThisWorkbook.Sheets("TUESDAY")
Set ws4 = ThisWorkbook.Sheets("WEDNESDAY")
Set ws5 = ThisWorkbook.Sheets("THURSDAY")
Set ws6 = ThisWorkbook.Sheets("FRIDAY")

iLastRow = ws1.Range("B5").End(xlDown).Row

iOutRow = 10
For iRow = 5 To iLastRow
iOutRow = iOutRow + 1
ws1.Cells(iRow, "B").Copy Destination:=ws2.Cells(iOutRow, "A")
If ws1.Cells(iRow, "B").Value >= 4100 And ws1.Cells(iRow, "B").Value <= 4130 Then
iOutRow = iOutRow + 1
ws1.Cells(iRow, "B").Copy Destination:=ws2.Cells(iOutRow, "A")
End

This is part of macro. Bottom section i have repeated for Tusday to Friday
Macro works fine but needs a modification In the value 4100 and 4130 some will end in a letter such as 4125W. The macro does not copy twice values ending with a letter.

Can some one give me a modification to allow for this please.

Thanks, Ben

 

[VoG]

Try

If Val(Left(ws1.Cells(iRow, "B").Value, 4)) >= 4100 And Val(Left(ws1.Cells(iRow, "B").Value, 4)) <= 4130 Then

 

[Beekman]

Tried you mod but had no effect