Question

我正在尝试以特定方式将两张纸加在一起，以便从测试台上查看我的数据。我的计划是建立一个可以自行完成的宏。

每个图片都是不同的工作表，因此“软件-测试1和2”是单独的工作表，“结果”也是其自己的工作表。我已经尝试了一段时间，我可以将两张表复制到结果表中，但是我无法让“软件-测试1”和“软件-测试2”彼此相邻移动（如“结果表”中所示）。我的脚本只能在“测试1”下添加“测试2”，但我需要它们彼此相邻。在工作簿中，我有+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

该脚本有效，因此我可以使用表单选择“结果表”，然后循环浏览工作簿中的每个表。可以将工作表名称中每个带有关键字“状态”的工作表添加到“结果表”中。一个对话框将要求添加或不添加特定的“状态表”，如果是，则添加，如果没有跳过表，则添加。然后，我遍历工作簿，并要求在工作表名称中带有“ Status”关键字的每个工作表。如果为“是”，则应如图3所示添加工作表，并在其下添加下一个“是”，但应在工作表的“软件-测试X”旁边添加“软件-测试X”部分。这是可能做到的，还是我只是梦想着做到这一点？谢谢

将两张纸加在一起，并在新纸上移动特定的列

0 个答案: