按特定順序將值從一列復制到另一張表

Question

我試圖在 excel 工作表中找到一個代碼來創建宏，該代碼將從名為“Panels”的工作表和“C”列（從 C3、C4 等開始）復制值並粘貼到名為“Pack”的工作表，但按特定順序：第一個單元格是A10，然后跳過B10，然后粘貼到C10，跳過D10，粘貼到E10，跳過F10，粘貼到G10，跳過H10，粘貼到I10，跳過J10，然后移動到下一行“11 " 使用相同的跳過和粘貼順序。

此 excel 工作表的目標是“面板”表包含需要制造的所有項目的列表，“包裝”表將包含要運送的相同項目的列表。 然后，操作員將在“已跳過”列中檢查標記正確的正在運送的物品。
附件是帶有虛構物品示例的“打包”表的屏幕截圖。

Answer 1

使用偏移復制和轉置

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