在特定标题下复制和粘贴

Question

我在 WIPTX 工作表下有 6 个不同的标题，它们将从 TestData 选项卡中提取信息，这些信息本质上是将从 SharePoint 网站上传的数据。我希望能够复制和粘贴具有特定值的行，例如状态类型或名称 在 WIPTX 工作表中的每个标题下。标题位于 A-C、E-G、I-K、M-O、Q-S 和 U-W 列中。标题在 TestData 工作表中具有不同的状态。状态包括已分配、已接受、进行中、暂停、已完成和已取消。 这可能吗？ 到目前为止我的代码可以工作，但它不会粘贴在特定的标题列下。

我已经尝试研究和寻找其他来源，但我仍然无法找到特定于我正在寻找的正确代码。

Sub Update1()

Dim LastRow1 As Long, LastRow2 As Long, i As Long

With ThisWorkbook.Worksheets("TestData")
      LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row
      For i = 1 To LastRow1
          If .Range("A" & i).Value = "Thomas Xiong" Then
              LastRow2 = ThisWorkbook.Worksheets("All Projects with NetBuilds").Cells(ThisWorkbook.Worksheets("All Projects with NetBuilds").Rows.Count, "A").End(xlUp).Row
              .Rows(i).Copy ThisWorkbook.Worksheets("All Projects with NetBuilds").Rows(LastRow2 + 1)
          End If
      Next i
End With

End Sub

这可能吗？

Answer 1

我认为这应该对您有所帮助：

Option Explicit
Sub Update1()

    Dim wsData As Worksheet, wsProjects As Worksheet, LastRow As Long, Col As Integer, CopyRange As Range, C As Range

    With ThisWorkbook
        Set wsData = .Sheets("TestData") 'refering the worksheet with all the data
        Set wsProjects = .Sheets("All Projects with NetBuilds") 'refering the worksheet with the headers
    End With


    For Each C In wsData.Range("A2", wsData.Cells(1, 1).End(xlDown)) 'Lets assume the criteria is on the column A
        With wsData
            Select Case C.Value
                Case "Assigned"
                    With wsData
                        Set CopyRange = .Range(.Cells(C.Row, 3), .Cells(C.Row, 5)) 'Here I'm assuming you want to copy data from Columns B To D
                    End With
                Case "Accepted"
                    With wsData
                        Set CopyRange = .Range(.Cells(C.Row, 7), .Cells(C.Row, 9)) 'Here I'm assuming you want to copy data from Columns G To I
                    End With

            '... all your headers
            End Select
        End With
        With wsProjects
            Col = .Cells.Find(C).Column 'Find the header column
            LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row + 1 'find the last row on that header
            CopyRange.Copy .Cells(LastRow, Col) 'paste the range (this method will copy everything from the source)
        End With
    Next C

    'In case you are always copying the same range of cells skip the select case, delete the CopyRange variable and just copy paste on the last block

End Sub