macro to shift columns in sequence

exposuresample.xlsm

Hi there,

this code did the trick:

Option Explicit
Sub CorrectArray()
Dim sht As Worksheet
Dim XCol, XRow As Integer

Set sht = Sheets("Sheet1")

For XRow = 515 To sht.UsedRange.Rows.Count
  If sht.Cells(XRow, 1) = 1 Then
    XCol = sht.Cells(XRow - 2, 2)
    sht.Cells(XRow - 2, 2).Resize(514, 7).Copy
    sht.Cells(1, XCol + 1).PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
    XRow = XRow + 514
  End If
Next XRow

sht.Cells(515, 1).Resize(sht.UsedRange.Rows.Count - 514, 1).EntireRow.Delete
End Sub

Try it on full size sample and let me know if it is OK...

So I hope i helps

Regards

M