Split row into two rows, one header and one line row

[rrmando18]

Good afternoon party people...hope everyone is doing great. I have been searching the forums but have not found anything yet. We are going to have between 100-200 rows at a time, one invoice per row, that we need to split into two separate rows so we can import into our ERP. We need to create one header row and one line row for each invoice row.

Below is an example. The top part is what we're trying to get to. That is the import template we need to use. ARBH is the header row. ARBL is the line row. On the bottom portion, Contract, Invoice, Description, Customer, TransDate need to go on the header row (ARBH row). Amount, Item, UM, ECM and ARLine need to go on the line row (ARBL row).

Any suggestions? Thank you for your help.

 

[dermie_72]

you could try this code:

Sub rrmando18()
Dim srcsht As Worksheet, tgtsht As Worksheet
Dim rw1 As Integer, rw2 As Integer
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.DisplayAlerts = False
LR = Cells(Rows.count, "A").End(xlUp).Row
Set srcsht = ActiveSheet
Set tgtsht = Worksheets.Add
rw1 = 1
rw2 = 2
For I = 2 To LR 'Change the 2 to the first row of data that you want to do this too
    Sheets(tgtsht.Name).Range("A" & rw1).Value = "ARBH"
    Sheets(tgtsht.Name).Range("B" & rw1).Value = Sheets(srcsht.Name).Range("A" & I).Value
    Sheets(tgtsht.Name).Range("C" & rw1).Value = Sheets(srcsht.Name).Range("B" & I).Value
    Sheets(tgtsht.Name).Range("D" & rw1).Value = Sheets(srcsht.Name).Range("C" & I).Value
    Sheets(tgtsht.Name).Range("E" & rw1).Value = Sheets(srcsht.Name).Range("D" & I).Value
    Sheets(tgtsht.Name).Range("F" & rw1).Value = Sheets(srcsht.Name).Range("E" & I).Value
    Sheets(tgtsht.Name).Range("A" & rw2).Value = "ARBL"
    Sheets(tgtsht.Name).Range("B" & rw2).Value = Sheets(srcsht.Name).Range("F" & I).Value
    Sheets(tgtsht.Name).Range("C" & rw2).Value = Sheets(srcsht.Name).Range("G" & I).Value
    Sheets(tgtsht.Name).Range("D" & rw2).Value = Sheets(srcsht.Name).Range("H" & I).Value
    Sheets(tgtsht.Name).Range("F" & rw2).Value = Sheets(srcsht.Name).Range("I" & I).Value
    Sheets(tgtsht.Name).Range("J" & rw2).Value = Sheets(srcsht.Name).Range("J" & I).Value
    Sheets(tgtsht.Name).Range("K" & rw2).Value = Sheets(srcsht.Name).Range("K" & I).Value
    rw1 = rw1 + 2
    rw2 = rw2 + 2
Next I
Columns("A:K").AutoFit
Set srcsht = Nothing
Set tgtsht = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

 

[rrmando18]

you could try this code:

Sub rrmando18()
Dim srcsht As Worksheet, tgtsht As Worksheet
Dim rw1 As Integer, rw2 As Integer
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.DisplayAlerts = False
LR = Cells(Rows.count, "A").End(xlUp).Row
Set srcsht = ActiveSheet
Set tgtsht = Worksheets.Add
rw1 = 1
rw2 = 2
For I = 2 To LR 'Change the 2 to the first row of data that you want to do this too
    Sheets(tgtsht.Name).Range("A" & rw1).Value = "ARBH"
    Sheets(tgtsht.Name).Range("B" & rw1).Value = Sheets(srcsht.Name).Range("A" & I).Value
    Sheets(tgtsht.Name).Range("C" & rw1).Value = Sheets(srcsht.Name).Range("B" & I).Value
    Sheets(tgtsht.Name).Range("D" & rw1).Value = Sheets(srcsht.Name).Range("C" & I).Value
    Sheets(tgtsht.Name).Range("E" & rw1).Value = Sheets(srcsht.Name).Range("D" & I).Value
    Sheets(tgtsht.Name).Range("F" & rw1).Value = Sheets(srcsht.Name).Range("E" & I).Value
    Sheets(tgtsht.Name).Range("A" & rw2).Value = "ARBL"
    Sheets(tgtsht.Name).Range("B" & rw2).Value = Sheets(srcsht.Name).Range("F" & I).Value
    Sheets(tgtsht.Name).Range("C" & rw2).Value = Sheets(srcsht.Name).Range("G" & I).Value
    Sheets(tgtsht.Name).Range("D" & rw2).Value = Sheets(srcsht.Name).Range("H" & I).Value
    Sheets(tgtsht.Name).Range("F" & rw2).Value = Sheets(srcsht.Name).Range("I" & I).Value
    Sheets(tgtsht.Name).Range("J" & rw2).Value = Sheets(srcsht.Name).Range("J" & I).Value
    Sheets(tgtsht.Name).Range("K" & rw2).Value = Sheets(srcsht.Name).Range("K" & I).Value
    rw1 = rw1 + 2
    rw2 = rw2 + 2
Next I
Columns("A:K").AutoFit
Set srcsht = Nothing
Set tgtsht = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

This works great. Thank you so much!