Sub RunMe() Dim sSheet, dSheet As Worksheet Dim x, lRow, mV1, mV2 As Integer Set sSheet = Sheets("Source") Set dSheet = Sheets("Destination") x = 66 dSheet.Select lRow = Range("A" & Rows.Count).End(xlUp).Row + 1 Do Range(Cells(lRow, "B"), Cells(lRow + 2, "B")).Value = Left(sSheet.Range("A" & x), 8) Range(Cells(lRow, "C"), Cells(lRow + 2, "C")).Value = Right(sSheet.Range("A" & x), Len(sSheet.Range("A" & x)) - 8) Range(Cells(lRow, "A"), Cells(lRow + 2, "A")).Value = sSheet.Range("C" & x) Range("D" & lRow).Value = sSheet.Range("A" & x + 2).Value If sSheet.Range("B" & x + 2).Value = vbNullString Then mV1 = sSheet.Range("C" & x + 2).Value Range("E" & lRow).Value = "(" & mV1 & ")" Else mV2 = sSheet.Range("B" & x + 2).Value Range("E" & lRow).Value = mV2 End If Range("D" & lRow + 1).Value = sSheet.Range("A" & x + 3).Value If sSheet.Range("B" & x + 3).Value = vbNullString Then mV1 = sSheet.Range("C" & x + 3).Value Range("E" & lRow + 1).Value = "(" & mV1 & ")" Else mV2 = sSheet.Range("B" & x + 3).Value Range("E" & lRow + 1).Value = mV2 End If Range("E" & lRow + 2).Value = mV2 - mV1 x = x + 8 lRow = lRow + 3 Loop Until sSheet.Range("A" & x).Value = vbNullString End Sub
DON'T MISS