Копировать и вставить под конкретным заголовком

Question

У меня есть 6 различных заголовков под рабочим листом WIPTX, которые будут извлекать информацию из вкладки TestData, которая по сути представляет собой данные, которые будут загружены с сайта SharePoint.Я хочу иметь возможность копировать и вставлять строки, которые имеют определенные значения, такие как тип состояния или по имени, под каждым заголовком на листе WIPTX.Заголовки находятся в столбцах AC, EG, IK, MO, QS и UW.Заголовки имеют разные состояния, которые находятся в рабочем листе 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