[英]Copy values from one column to another sheet in certain order
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.我试图在 excel 工作表中找到一个代码来创建宏,该代码将从名为“Panels”的工作表和“C”列(从 C3、C4 等开始)复制值并粘贴到名为“Pack”的工作表,但按特定顺序:第一个单元格是A10,然后跳过B10,然后粘贴到C10,跳过D10,粘贴到E10,跳过F10,粘贴到G10,跳过H10,粘贴到I10,跳过J10,然后移动到下一行“11 " 使用相同的跳过和粘贴顺序。
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.此 excel 工作表的目标是“面板”表包含需要制造的所有项目的列表,“包装”表将包含要运送的相同项目的列表。 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.附件是带有虚构物品示例的“打包”表的屏幕截图。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.