在特定标题下复制和粘贴

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