Need help

[Beekman]

Public Sub ShiftsCopyBlockTwice()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
Dim ws1 As Worksheet<o></o>
Dim ws2 As Worksheet<o></o>
Dim ws3 As Worksheet<o></o>
Dim ws4 As Worksheet<o></o>
Dim ws5 As Worksheet<o></o>
Dim ws6 As Worksheet<o></o>
Dim iLastRow As Long<o></o>
Dim iRow As Long<o></o>
Dim iOutRow As Long<o></o>
<o></o>
Set ws1 = ThisWorkbook.Sheets("HEADER")<o></o>
Set ws2 = ThisWorkbook.Sheets("MONDAY")<o></o>
Set ws3 = ThisWorkbook.Sheets("TUESDAY")<o></o>
Set ws4 = ThisWorkbook.Sheets("WEDNESDAY")<o></o>
Set ws5 = ThisWorkbook.Sheets("THURSDAY")<o></o>
Set ws6 = ThisWorkbook.Sheets("FRIDAY")<o></o>
<o></o>
iLastRow = ws1.Range("B5").End(xlDown).Row<o></o>
<o></o>
iOutRow = 10<o></o>
For iRow = 5 To iLastRow<o></o>
iOutRow = iOutRow + 1<o></o>
ws1.Cells(iRow, "B").Copy Destination:=ws2.Cells(iOutRow, "A")<o></o>
If ws1.Cells(iRow, "B").Value >= "4100" And ws1.Cells(iRow, "B").Value <= "4130" Then<o></o>
iOutRow = iOutRow + 1<o></o>
ws1.Cells(iRow, "B").Copy Destination:=ws2.Cells(iOutRow, "A")<o></o>
End If<o></o>
Above is part of macro i am using and works fine.
I have on Header sheet a list in ColB from 4000 to 4130
Above macro relists these numbers in Col A in MONDAY with numbers
4100 to 4130 listed twice eg:-

4000
4001
4002
4003
4004 etc

4100
4100
4101
4101
4102
4102 etc

I have in "HEADER" Col C and Col E a list of times corresponding to the the list of numbers 4000 to 4130

I need to list Col C with the List of numbers 4000 to 4130 in "MONDAY" and Col E
with the second numbers 4100 to 4130 eg



4000 7:00 Time from Col C
4001 7:12 Time from Col C
4002 7:20
4100 8:05 Time from Colc
4100 14:30 Time from Col E
4102 8:10
4102 14:40

This Process will be repeated in "TUESDAY"to "FRIDAY"

Appreciate any help as I'm Hopeless at Macros but trying to learn

 

[moonfish]

This should do what you're requesting. I highlighted the changes in red so you can see what happened and try to understand what's going on.

Public Sub ShiftsCopyBlockTwice()

  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")
    ws1.Cells(iRow, "C").Copy Destination:=ws2.Cells(iOutRow, "B")
    ws1.Cells(iRow, "B").Copy Destination:=ws3.Cells(iOutRow, "A")
    ws1.Cells(iRow, "C").Copy Destination:=ws3.Cells(iOutRow, "B")
    ws1.Cells(iRow, "B").Copy Destination:=ws4.Cells(iOutRow, "A")
    ws1.Cells(iRow, "C").Copy Destination:=ws4.Cells(iOutRow, "B")
    ws1.Cells(iRow, "B").Copy Destination:=ws5.Cells(iOutRow, "A")
    ws1.Cells(iRow, "C").Copy Destination:=ws5.Cells(iOutRow, "B")
    ws1.Cells(iRow, "B").Copy Destination:=ws6.Cells(iOutRow, "A")
    ws1.Cells(iRow, "C").Copy Destination:=ws6.Cells(iOutRow, "B")
    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")
      ws1.Cells(iRow, "E").Copy Destination:=ws2.Cells(iOutRow, "B")
      ws1.Cells(iRow, "B").Copy Destination:=ws3.Cells(iOutRow, "A")
      ws1.Cells(iRow, "E").Copy Destination:=ws3.Cells(iOutRow, "B")
      ws1.Cells(iRow, "B").Copy Destination:=ws4.Cells(iOutRow, "A")
      ws1.Cells(iRow, "E").Copy Destination:=ws4.Cells(iOutRow, "B")
      ws1.Cells(iRow, "B").Copy Destination:=ws5.Cells(iOutRow, "A")
      ws1.Cells(iRow, "E").Copy Destination:=ws5.Cells(iOutRow, "B")
      ws1.Cells(iRow, "B").Copy Destination:=ws6.Cells(iOutRow, "A")
      ws1.Cells(iRow, "E").Copy Destination:=ws6.Cells(iOutRow, "B")
    End If
  Next iRow
End Sub

It could be that your code had more at the end. Your original post did not include the 'next iRow' and 'End Sub' lines.

 

[Beekman]

Thank you very much 'Moonfish'. Seems to work perfectly.

I guess I could add in extra colums to each Ws1,Ws2,Ws3 etc to fill in extra info into other columns .

I'll give it a try, again many thanks