尝试跨工作表复制和粘贴到单个工作表中，其中包含不同范围的信息

Question

我有一个工作表，允许选择一个零件号，并拉出它所经历的所有操作，每个操作的步骤都在不同的工作表上。我尝试创建的是基于它将所有操作过程拉入一张工作表进行打印的操作。不是所有操作都有相同数量的步骤，也不是每个零件都有相同数量的操作。

我的代码适用于第一个操作，第二个操作的前3行。但我不能让它把所有的床单都拉出来。下面是我使用的代码。目前，我只专注于操作1和操作2，一旦我了解到它必须能够从大约30个选择中选择16个不同的操作。

Dim rng As Range

If Sheets("Selection").Range("D3").Text = "N/A" Then
    Exit Sub
Else
    Set rng = Sheets(Sheets("Selection").Range("D3").Text).Range("A12:" & ActiveSheet.Range("S12").End(xlDown).Address)
    With rng
        .Copy
    End With
    With Sheets("Print FMEA").Range("S" & Rows.Count).End(xlUp).Offset(1, -18)
    .PasteSpecial xlPasteFormats
    .PasteSpecial xlPasteValues
    End With

End If

If Sheets("Selection").Range("D4").Text = "N/A" Then
    Exit Sub
Else
    Set rng = Sheets(Sheets("Selection").Range("D4").Text).Range("A12:" & ActiveSheet.Range("S12").End(xlDown).Address)
    With rng
        .Copy
    End With
    With Sheets("Print FMEA").Range("S" & Rows.Count).End(xlUp).Offset(1, -18)
    .PasteSpecial xlPasteFormats
    .PasteSpecial xlPasteValues
    End With

End If

End Sub

Answer 1

让我们先处理一下错误：

此行将抛出错误Sheets("Print FMEA").Row (Lastrow + 1)。我不知道你想用它做什么，但是语法是不正确的。我有点惊讶你说代码已经为你工作了。

此行将仅选择下一个空白单元格Set rng = Sheets(Sheets("Selection").Range("D4").Text).Range("A12:" & ActiveSheet.Range("S12").End(xlDown).Address)的数据。您可能只得到前三行，因为第四行是空白的。

为了回答你的问题，我认为你需要从两个方面考虑这个问题：

1. 通过每个操作存储每个operation.
2. Loop的参考详细信息，并处理这些详细信息。

有很多方法可以做到这一点，但Class对象可以很好地工作。我已经给出了一个例子，它没有充分利用一个类，但它确实区分了这两个任务。

因此，对于第1部分，插入一个新类(插入~>类模块)并将其命名为OpsFields。插入以下存储工作表和单元格引用的代码：

Private mSourceSheet As Worksheet
Private mRefSheet As Worksheet
Private mRefFirstRange As Range

Public Sub SetRefSheetAddress(sourceSheet As String, cellAddress As String)
    Dim sheetName As String

    Set mSourceSheet = ThisWorkbook.Worksheets(sourceSheet)
    sheetName = mSourceSheet.Range(cellAddress)
    Set mRefSheet = ThisWorkbook.Worksheets(sheetName)
End Sub

Public Sub SetFirstRefAddress(columnsAddress As String, firstRow As Long)
    Set mRefFirstRange = Intersect(mRefSheet.Columns(columnsAddress), _
                         mRefSheet.Rows(firstRow).EntireRow)
End Sub

Public Function GetDataRange()
    Dim r As Long
    Dim c As Long
    Dim lastRow As Long
    Dim rowCount As Long

    r = mRefSheet.Rows.Count
    c = mRefFirstRange.Columns(1).Column
    lastRow = mRefSheet.Cells(r, c).End(xlUp).Row
    rowCount = lastRow - mRefFirstRange.Rows(1).Row + 1
    Set GetDataRange = mRefFirstRange.Resize(rowCount)
End Function

然后填充这些类并将它们存储到某种列表中-我使用了一个Collection，因为您不必对它进行重新标注，所以操作的数量并不重要。在下面的代码中，我已经给出了两个示例，但是您可以添加任意数量的代码。这段代码应该在你的Module中

Private mOpsList As Collection 'at top of module



Sub CreateOpsFields()
    Dim ops As OpsFields

    Set mOpsList = New Collection

    Set ops = New OpsFields
    ops.SetRefSheetAddress "Selection", "D3"
    ops.SetFirstRefAddress "A:S", 12
    mOpsList.Add ops

    Set ops = New OpsFields
    ops.SetRefSheetAddress "Selection", "D4"
    ops.SetFirstRefAddress "A:S", 12
    mOpsList.Add ops

End Sub

对于第2部分，您只需循环遍历类列表并执行粘贴任务，如下所示(同样在您的Module中)：

Sub RecordOps()
    Dim outputSheet As Worksheet
    Dim ops As OpsFields
    Dim data As Range
    Dim nextBlankRow As Long

    Set outputSheet = ThisWorkbook.Worksheets("Print FMEA")
    nextBlankRow = outputSheet.Cells(outputSheet.Rows.Count, "S").End(xlUp).Row
    For Each ops In mOpsList
        Set data = ops.GetDataRange
        data.Copy
        With outputSheet.Cells(nextBlankRow, "A").Resize(data.Rows.Count, data.Columns.Count)
            .PasteSpecial xlPasteFormats
            .PasteSpecial xlPasteValues
        End With
        nextBlankRow = nextBlankRow + data.Rows.Count
    Next
End Sub

您以正常的方式调用这些例程。一种显而易见的方法是在某种初始化例程中填充类，然后在某个事件被触发时调用粘贴例程。我刚刚将这两个调用放在一个例程中，这样您就可以看到语法：

Sub RunMe()
    CreateOpsFields
    RecordOps
End Sub