Copy values from one column to another sheet in certain order-CodePudding

I am trying to find a code to create macro in excel sheet that would copy values from sheet called "Panels" and column "C" (starting with C3, C4, etc,) and paste to sheet called "Pack" but in specific order: the first cell would be A10, and then skip B10, then paste to C10, skip D10, paste to E10, skip F10, paste to G10, skip H10, paste to I10, skip J10, and then move to next row "11" with the same order of skip and paste.

The goal of this excel worksheet is that "Panels" sheet has list of all items' needed to be manufactured, and "Pack" sheet will have a list of same items to be shipped. Operators will then check mark correct items being shipped in "skipped" columns.
Attached is a screenshot of the "Pack" sheet with examples of imaginary items.

CodePudding user response：

Copy and Transpose With Offset

Option Explicit

Sub FillPack()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source (read (copied) from)
    Dim sws As Worksheet: Set sws = wb.Worksheets("Panels") ' Worksheet
    Dim sfRow As Long: sfRow = 3 ' First Row
    Dim slRow As Long ' Last Row
    slRow = sws.Cells(sws.Rows.Count, "C").End(xlUp).Row
    If slRow < sfRow Then Exit Sub ' no data
    
    ' Destination (written to)
    Dim dws As Worksheet: Set dws = wb.Worksheets("Pack") ' Worksheet
    Dim dfRow As Long: dfRow = 10 ' First Row
    Dim dr As Long: dr = dfRow ' Current Row
    Dim dfCol As Long: dfCol = 1 ' First Column
    Dim dc As Long: dc = dfCol ' Current Column
    Dim dlCol As Long: dlCol = 9 ' Last Column
    Dim dlRow As Long ' Last Row (just to clear the previous data)
    dlRow = dws.Cells(dws.Rows.Count, dfCol).End(xlUp).Row
    If dlRow >= dfRow Then ' Clear previous data
        dws.Range(dws.Cells(dfRow, dfCol), dws.Cells(dlRow, dlCol)).ClearContents
    End If
    
    Dim sr As Long ' Current Row
    
    For sr = sfRow To slRow ' loop through cells of column 'C'
        dws.Cells(dr, dc).Value = sws.Cells(sr, "C").Value ' copy value
        If dc < dlCol Then
            dc = dc   2 ' every other column
        Else
            dr = dr   1 ' when all columns are filled then next row...
            dc = dfCol ' ... and start with first column
        End If
    Next sr
        
    MsgBox "Pack filled.", vbInformation
    
End Sub