Добавьте два листа вместе и перенесите определенный столбец в новый лист

Question

Я пытаюсь сложить вместе два листа особым образом, чтобы увидеть мои данные с моего тестового стенда. Мой план состоит в том, чтобы создать Макрос, который дозирует это сам.

Каждое изображение - это отдельный лист, поэтому «Программное обеспечение - тест 1 и 2» - это отдельные листы, а «Результат» - это тоже отдельный лист. Я пытался для себя некоторое время, и я могу заставить эти два листа скопировать в лист результатов, но я не могу заставить "Программное обеспечение - тест 1" и "Программное обеспечение - тест 2" смещаться рядом друг с другом ( как показано в «листе результатов»). Мой сценарий может только добавить «тест 2» под «тест 1», но мне нужно, чтобы они были рядом друг с другом. В рабочей тетради у меня +10 листов.

Sub MergeSheets()
    Dim WorkSheetSource As Worksheet
    Dim WorkSheetDestination As Worksheet
    Dim RangeSource As Range
    Dim RangeDestination As Range
    Dim lngLastCol As Long
    Dim lngSourceLastRow As Long
    Dim lngDestinationLastRow As Long
    Dim SheetName As String
    Dim SkipSheets As String
    Dim Response As String ' Input form updateform
    Dim CopyFromColumne As Integer
    Dim CopyFromRow As Integer
    Dim AddMoreColumnes As Integer
    '----------- Open Form -----------------------------------
    Set StatusSheet = Nothing
    ShowUpdateForm
    If StatusSheet Is Nothing Then ' If error
        MsgBox "Wrong sheet selected"
        Exit Sub
    End If
    If Not Init Then ' If empty
        Exit Sub
    End If
    '-----------------------------------------------------------
    ' Get the name of the selected sheet
    Response = StatusSheet.Name
    'Set references up-front
    Set WorkSheetDestination = ThisWorkbook.Worksheets(Response)
    CopyFromRow = 1
    CopyFromColumne = 1
    AddMoreColumnes = 100 ' temporary
    lngDestinationLastRow = LastOccupiedRowNum(WorkSheetDestination) ' defined below
    lngLastCol = LastOccupiedColNum(WorkSheetDestination) ' defined below
    'Set the initial destination range
    Set RangeDestination = WorkSheetDestination.Cells(lngDestinationLastRow + 0, 1)
                                ' (lngDestinationLastRow + 2) = what row to start adding on, 1 = start from column
                                ' the 2 makes a blank row between sheeeeets
    'Loop through all sheets
    For Each WorkSheetSource In ThisWorkbook.Worksheets
        ' Skip this sheets
        SkipSheets = ("Stacked Status,Cover sheet,Control,Column description,Charts description") & Response
        'Make sure we skip the "Import" destination sheet!
        If InStr(1, SkipSheets & ",", WorkSheetSource.Name & ",", vbTextCompare) = 0 Then
            ' Skip all Charts sheets and only chose Status sheets
            If InStr(WorkSheetSource.Name, "Status") Then
                MsgboxQuestion = "Add requierments from '" & WorkSheetSource.Name & "'  to '" & Response & "' (Yes/No)"
                'Display MessageBox
                Answer = MsgBox(MsgboxQuestion, vbQuestion + vbYesNo, "Update Status sheet")
                If Answer = vbYes Then
                    ' Keep going through THIS!! function
                ElseIf Answer = vbNo Then
                    ' Jump out of for loop.
                    GoTo NextWorkSheetSource
                End If
                'Identify the last occupied row on this sheet
                lngSourceLastRow = LastOccupiedRowNum(WorkSheetSource)     
                        'Store the source data then copy it to the destination range
                    With WorkSheetSource
                        Set RangeSource = .Range(.Cells(CopyFromRow, CopyFromColumne), .Cells(lngSourceLastRow, AddMoreColumnes))
                        'Set RangeSource = .Range(.Cells(1, 1), .Cells(lngSourceLastRow, lngLastCol))
                                        '  (what start row, start column)
                        RangeSource.Copy Destination:=RangeDestination
                        CopyFromRow = 3 ' after the first sheet has been added set rowcopy to 3 to skip column name rows
                    End With             
                'Redefine the destination range now that new data has been added
                lngDestinationLastRow = LastOccupiedRowNum(WorkSheetDestination)
                Set RangeDestination = WorkSheetDestination.Cells(lngDestinationLastRow + 1, 1)
                ThisWorkbook.Worksheets(Response).Range("A" & Rows.Count).End(xlUp).EntireRow.Interior.ColorIndex = 15 ' make a gray line 
            End If
        End If 
'If "for loop" answer is No, skip and take next one
NextWorkSheetSource:
    Next WorkSheetSource
    TurnOnFunctionality
    MsgBox "All selected Sheets are added together in 'Stacked Status'"
End Sub

Сценарий работает так, что я использую форму, чтобы выбрать «Лист результатов», а затем перебираю все листы в книге. Каждый лист с ключевым словом «Статус» в названии листа может быть добавлен в «Лист результатов». Диалоговое окно попросит добавить или не добавлять конкретный «Лист состояния», если да, то добавить, если нет пропустить лист. Затем я перебираю книгу и запрашиваю каждый лист с ключевым словом «Статус» в названии листа. Если «да», лист должен быть добавлен, как на рисунке 3, а следующее «да» должно быть добавлено внизу, но часть «Software-test X» должна быть добавлена ​​рядом с «Software-test X» из листа ранее. Это возможно сделать, или я просто мечтаю, что это может быть сделано? Спасибо