How to copy and paste into new sheet using VBA

I have a table with a confirmation (reference + quantity + date), I want to copy this info in a new sheet, but as follows :

col A : reference - Col B : quantity - Col C : date 1 (as in cel C4)

a new row for each reference, and then we start again with the list of references and quantities, but for the second date (as in cel C5), and so on (for all 5 dates)

example confirmation to start with

it needs to look like this

This is my code so far ...

   Sub EDIinvullen()

     Application.ScreenUpdating = False
     
     Worksheets("OmzettingEDI-1").Range("A1:F200").clear
     
    
    Dim lastrow As Integer

    Dim wksSource As Worksheet, wksDest As Worksheet
    Dim rngStart As Range, rngSourcedat1 As Range, rngDest1 As Range, rngSourcedat2 As Range, rgnDest2 As     Range, rngDatum1 As Range

    Set wksSource = ActiveWorkbook.Sheets("Bevestiging P&G")
    Set wksDest1 = ActiveWorkbook.Sheets("OmzettingEDI-1")


    lastrow = wksSource.Range("A4").End(xlDown).Row

    Set rngSourcedata = wksSource.Range("C4:G" & lastrow) 'gebruikt om alle lege velden met 0 in te vullen
    Set rngSourcedat1 = wksSource.Range("A5:A" & lastrow & ",C5:C" & lastrow) 'referentie en aantal van datum 1
    Set rngSourcedat2 = wksSource.Range("A5:A" & lastrow & ",D5:D" & lastrow) 'referentie en aantal van datum 2
    Set rngDatum1 = wksSource.Range("C4") 'datum 1 - werkt niet

On Error Resume Next
    InputValue = 0
    For Each cell In rngSourcedata
    If IsEmpty(cell) Then
    cell.Value = InputValue
    End If
    Next

    Set rngDest1 = wksDest1.Range("A1")
    rngSourcedat1.Copy
    rngDest1.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

  rngDatum1 = wksDest1.Range("C1")
   rngDatum1.Copy
  rngDest1.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
    Set rngDest2 = wksDest1.Range("D1")
    rngSourcedat2.Copy
    rngDest2.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

  Application.CutCopyMode = False
  Application.ScreenUpdating = True

End Sub

This gives me Col A and Col C next to eachother, but I can't figure out how to get the date in the third column, and then I also need to get all the info in one list below eachother.

I think using a loop would also work, but I have no clue how to code that

help is appreciated

I spent hours and hours looking for online help, tried to adapt my code, but I get nowhere near the result I need.

Try this code:

Sub SubRearrangeList()
    
    'Declarations.
    Dim RngList As Range
    Dim DblColumn As Double
    Dim DblRow As Double
    Dim DblIndex As Double
    Dim VarResult As Variant
    Dim RngResult As Range
    
    'Settings.
    Set RngList = ActiveWorkbook.Sheets("Bevestiging P&G").Range("A4")
    Set RngResult = ActiveWorkbook.Sheets("OmzettingEDI-1").Range("A1")
    
    'Setting RngList to cover the whole list.
    Set RngList = RngList.Parent.Range(RngList, RngList.End(xlDown))
    Set RngList = RngList.Parent.Range(RngList, RngList.End(xlToRight))
    
    'Setting VarResult to accomodate the results.
    ReDim VarResult(1 To (RngList.Columns.Count - 2) * (RngList.Rows.Count - 1), 1 To 3)
    
    'Covering each cell of the list under the dates columns.
    For DblColumn = 1 To RngList.Columns.Count - 2
        For DblRow = 1 To RngList.Rows.Count - 1
            
            'Setting DblIndex to track the "row" of VarResult.
            DblIndex = DblIndex + 1
            
            'Setting VarResult with the reference value for the given "row".
            VarResult(DblIndex, 1) = RngList(DblRow + 1, 1).Value2
            
            'Setting VarResult with the quantity(?) value for the given "row".
            VarResult(DblIndex, 2) = RngList(DblRow + 1, DblColumn + 2).Value2
            
            'Setting VarResult with the date value for the given "row".
            VarResult(DblIndex, 3) = RngList(1, DblColumn + 2).Value2
            
        Next
    Next
    
    'Setting RngResult to accomodate the data of VarResult.
    Set RngResult = RngResult.Resize(UBound(VarResult, 1), UBound(VarResult, 2))
    
    'Reporting VarResult in RngResult.
    RngResult.Value2 = VarResult
    
    'Setting the format column 3 of VarResult.
    RngResult.Columns(3).NumberFormat = "dd.mm.yy"
    
End Sub

Transform Data: Unpivot Using VBA

Description

• This code is designed to "unpivot" data in an Excel worksheet. This means that data that is arranged in a cross-tabulated or "pivoted" format, where each row contains multiple columns of data, is transformed into a "long" format where each row represents a single data point.

The Code

• Your 2nd screenshot shows that you don't want to copy the 2nd column. if you change your mind, just add a 2 to the array: srlColumns = VBA.Array(1, 2).

<!-- language: lang-vb -->

Sub EDIinvullen()
    
    Const SRC_SHEET As String = "Bevestiging P&G"
    Const SRC_FIRST_CELL As String = "A4"
    Const SRC_FIRST_CL_COLUMN As Long = 3
    Dim srlColumns(): srlColumns = VBA.Array(1)
    
    Const DST_SHEET As String = "OmzettingEDI-1"
    Const DST_FIRST_CELL As String = "A2"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
    Dim sfCell As Range: Set sfCell = sws.Range(SRC_FIRST_CELL)
    Dim srg As Range
    With sfCell.CurrentRegion
        Set srg = sws.Range(sfCell, .Cells(.Cells.CountLarge))
    End With
    
    Dim srCount As Long: srCount = srg.Rows.Count
    Dim scCount As Long: scCount = srg.Columns.Count
    
    Dim sData(): sData = srg.Value
    
    Dim snUpper As Long: snUpper = UBound(srlColumns)
    
    Dim dData(): ReDim dData(1 To (srCount - 1) _
        * (scCount - SRC_FIRST_CL_COLUMN + 1), 1 To snUpper + 3)
    
    Dim sr As Long, sc As Long, sn As Long, dr As Long, dc As Long
    
    For sc = SRC_FIRST_CL_COLUMN To scCount
        For sr = 2 To srCount
            dr = dr + 1
            dc = 0
            ' Row Labels
            For sn = 0 To snUpper
                dc = dc + 1
                dData(dr, dc) = sData(sr, srlColumns(sn))
            Next sn
            ' Values
            dc = dc + 1
            dData(dr, dc) = sData(sr, sc)
            ' Column Labels
            dc = dc + 1
            dData(dr, dc) = sData(1, sc)
        Next sr
    Next sc

    Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
    Dim dfCell As Range: Set dfCell = dws.Range(DST_FIRST_CELL)
    Dim drg As Range: Set drg = dfCell.Resize(dr, dc)
    
    drg.Value = dData
    drg.Resize(dws.Rows.Count - drg.Row - dr + 1).Offset(dr).Clear
    
    MsgBox "Data unpivoted.", vbInformation
     
End Sub

The Flow

• The source data is read into an array using the CurrentRegion property of a starting cell on the worksheet. The destination worksheet is defined by a starting cell and is sized to accommodate the new unpivoted data.

• The pivoted data is iterated over, and for each column, the values in each row are extracted along with the row labels and column labels. The row labels are placed in the first column(s) of the output array, the values are placed in the next column, and the column labels are placed in the last column.

• The unpivoted data is then written to the destination worksheet by writing the output array to a range defined by the starting cell on the destination worksheet. Any remaining cells below the data are cleared.