编写一个循环，从一个工作表中获取数据并根据过滤器粘贴到另一个工作表上

Question

我正在尝试根据 A 列中的值复制 2 列中的数据，并将其粘贴到同一工作簿中的正确工作表上。 因此，如果 PTP Dash 工作表中的 A 列是第 1 列，我想将该行中的 D 列和 F 列复制到 Div 1 工作表中的 A 列和 B 列中。D 列映射到新工作表上的 A 列，F 列映射到 B 列。 如果 PTP Dash 工作表中的 A 列是第 2 列，我想将该行中的列复制到 Div 2 工作表中的 A 列和 B 列中。D 列映射到新工作表上的 A 列，F 列映射到 B 列。 ETC... 我将每周运行一次，并且某个项目可能会出现在前一周输入的列表中，因此当我将其复制到 Div 1、Div 2、Div 3 选项卡时，我还想确认它不是重复的。
要复制的工作表的屏幕截图 要粘贴到的工作表屏幕截图

这就是我开始的，但是过滤器不起作用，并且循环不包含所需的所有内容。

Dim wsSource As Worksheet
Dim wsDestination As Worksheet
Dim lastRow As Long
Dim targetRow As Long


' Set the source worksheet and destination worksheet
 Set wsSource = Worksheets("PTP Dash")
 Set wsDestination = Worksheets("Div 1")
  
' Find the last row in column A of the source sheet
lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

' Initialize target row for pasting
targetRow = 2 ' Change if you want to start at a different row
    

For i = 2 To lastRow
    If wsSource.Cells(i, "A").Value = "1" Then

' Copy data from column D to column A in destination sheet
    wsSource.Range("D2:D" & lastRow).Copy wsDestination.Range("A2")

' Copy data from column F to column B in destination sheet
    wsSource.Range("F2:F" & lastRow).Copy wsDestination.Range("B2")

' Move to the next row in the target sheet
    targetRow = targetRow + 1

    End If
Next i

请参阅上面屏幕截图中的代码。

Answer 1

此代码适用于我的示例文件。我假设您想要检查“PTP Dash”表 F 列中的项目是否重复。仅 F 列中第一次出现的项目会返回到目标工作表。然而，代码有点慢，但如果每周运行应该没问题，我想知道“等等...”是什么意思。

Sub xxx()


Dim wsSource As Worksheet
Dim lastRow As Long
Dim targetRow As Long, i As Long, j As Long, k As Long, l As Long, m As 
Long

' Set the source worksheet and destination worksheet
Set wsSource = Worksheets("PTP Dash")

' Find the last row in column A of the source sheet
lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

' Initialize target row for pasting
targetRow = 2 ' Change if you want to start at a different row
j = 2
k = 2
l = 2

For i = 2 To lastRow

m = Application.WorksheetFunction.CountIfs(wsSource.Range("F2:F" & i), 
Cells(i, 6).Value)
If m = 1 Then

Select Case wsSource.Cells(i, "A").Value

Case Is = 1
wsSource.Range("D" & i).Copy Worksheets("Div 1").Range("A" & j)
wsSource.Range("F" & i).Copy Worksheets("Div 1").Range("B" & j)
j = j + 1
Case Is = 2
wsSource.Range("D" & i).Copy Worksheets("Div 2").Range("A" & k)
wsSource.Range("F" & i).Copy Worksheets("Div 2").Range("B" & k) 
k = k + 1
Case Is = 3
wsSource.Range("D" & i).Copy Worksheets("Div 3").Range("A" & l)
wsSource.Range("F" & i).Copy Worksheets("Div 3").Range("B" & l)
l = l + 1
End Select

Else
End If


Next i


End Sub