Excel Forum

Code: Select all

Sub OutputData()
Dim i As Long
Dim TargetRow As Long

Sheet5.Range("A1:H15").Clear

Sheet4.Range("A1:H1").Copy
Sheet5.Range("A1").PasteSpecial

For i = 2 To 15
TargetRow = Range("A1048576").End(xlUp).Row + 1

Sheet4.Range("A" & i).Copy
Sheet5.Range("A" & TargetRow).PasteSpecial xlPasteFormulasAndNumberFormats, xlPasteSpecialOperationNone, False, False

Next i

Application.CutCopyMode = False
Columns("A:H").AutoFit
MsgBox ("Complete")

End Sub

Code: Select all

Dim i As Long, rall As Range, r As Range
Dim TargetRow As Long

Sheet2.Range("A1:H15").Clear

Sheet1.Range("A1:H1").Copy Sheet2.Range("A1")

With Sheet1
    Set rall = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    For Each r In rall
        Sheet2.Cells(r.Row, 1).Value = r.Value
        Sheet2.Cells(r.Row, 2).Value = r.Offset(0, 1).Value
        Sheet2.Cells(r.Row, 3).Value = Application.Trim(r.Offset(0, 2).Value)
        Sheet2.Cells(r.Row, 4).Value = r.Offset(0, 3).Value
        Sheet2.Cells(r.Row, 5).Value = r.Offset(0, 4).Value
        Sheet2.Cells(r.Row, 6).Value = r.Offset(0, 5).Value
        Sheet2.Cells(r.Row, 7).Value = _
            Application.Index(Sheet1.Range("k2:k4"), _
            Application.Match(VBA.Split(r.Offset(0, 3).Value, " ")(0), _
            Sheet1.Range("j2:j4"), 0))
        Sheet2.Cells(r.Row, 8).Value = r.Offset(0, 7).Value
    Next r
End With

MsgBox ("Complete")