Macro for copying and pasting alternating lines, even and then odd.

[Smilin]

Hi, I have 16 lines, and I am trying to copy and paste the even number lines 1st, 2,4,6,8,10,12,14, 16 and under that the odd rows string with 3 and ending with 17. In addition to that, each day I update the 5 master sheets (5 tabs) with new 16 lines and they have to be pasted below the last line from the day before. I think it is possible just to have one macro run it from each tab. The values would be pasted from C to D, N to C, E to E and D to F. I welcome any help pls. I am hoping the macro from my previous post might be of use as it allows me to copy and paste below the last line containing values. Thank you .

 

[offthelip]

This shows you a way of doing it:

Sub test()
'copy even rows then oddrows for columns C to D
inarr = Range(Cells(1, 3), Cells(17, 4)) ' load all the data from columns C and D
Range(Cells(1, 3), Cells(17, 4)) = "" ' clear the workhseet
outarr = Range(Cells(1, 3), Cells(17, 4)) ' loadblank output
 indi = 1
 For i = 2 To 16 Step 2
  outarr(indi, 1) = inarr(i, 1)
  outarr(indi, 2) = inarr(i, 2)
  outarr(indi + 8, 1) = inarr(i + 1, 1)
  outarr(indi + 8, 2) = inarr(i + 1, 2)
  indi = indi + 1
 Next i
 
Range(Cells(1, 3), Cells(17, 4)) = outarr

End Sub

 

[Smilin]

This shows you a way of doing it:

Sub test()
'copy even rows then oddrows for columns C to D
inarr = Range(Cells(1, 3), Cells(17, 4)) ' load all the data from columns C and D
Range(Cells(1, 3), Cells(17, 4)) = "" ' clear the workhseet
outarr = Range(Cells(1, 3), Cells(17, 4)) ' loadblank output
 indi = 1
 For i = 2 To 16 Step 2
  outarr(indi, 1) = inarr(i, 1)
  outarr(indi, 2) = inarr(i, 2)
  outarr(indi + 8, 1) = inarr(i + 1, 1)
  outarr(indi + 8, 2) = inarr(i + 1, 2)
  indi = indi + 1
 Next i
 
Range(Cells(1, 3), Cells(17, 4)) = outarr

End Sub

This shows you a way of doing it:

Sub test()
'copy even rows then oddrows for columns C to D
inarr = Range(Cells(1, 3), Cells(17, 4)) ' load all the data from columns C and D
Range(Cells(1, 3), Cells(17, 4)) = "" ' clear the workhseet
outarr = Range(Cells(1, 3), Cells(17, 4)) ' loadblank output
 indi = 1
 For i = 2 To 16 Step 2
  outarr(indi, 1) = inarr(i, 1)
  outarr(indi, 2) = inarr(i, 2)
  outarr(indi + 8, 1) = inarr(i + 1, 1)
  outarr(indi + 8, 2) = inarr(i + 1, 2)
  indi = indi + 1
 Next i
 
Range(Cells(1, 3), Cells(17, 4)) = outarr

End Sub

Thank you for helping me out. It works. I am very grateful.