从每个过滤区域转移特定细胞

Question

我有下面的代码，它将所有可见的数据从"预表"转移到"合同"。

代码引用预表中的每个可见部分，调整合同中的区域大小，然后传输数据。

我想引用过滤区域内的特定列，这样我就可以单独传输特定列的数据。例如，我可能只想转移第一列和第六列。有人能帮忙吗

Public rnga As Range
Sub test()
    Dim wb As Excel.Workbook
    Set wb = ActiveWorkbook
    Dim sourceWS As Excel.Worksheet
    Set sourceWS = Prepsheet
    Dim filteredDataRange As Excel.Range
    Set filteredDataRange = sourceWS.AutoFilter.Range.Offset(1, 0)
     Set filteredDataRange = filteredDataRange.Resize(filteredDataRange.Rows.CountLarge - 1)
    Set filteredDataRange = filteredDataRange.SpecialCells(xlCellTypeVisible)
      Dim destinationWS As Excel.Worksheet
      Dim destinationRow As Long
      destinationRow = 1
         Dim area As Excel.Range
         For Each area In filteredDataRange.Areas
            Set rnga = area
            MatchSelectionArea
        Next area
End Sub
Sub MatchSelectionArea()
Dim rng As Range, cel As Range
Dim nRows As Long
Dim nCols As Long
Set cel = Contract.Range("a1048576").End(xlUp).Offset(1, 0)

    nRows = rnga.Rows.Count
    nCols = rnga.Columns.Count

    Set rng = cel.Resize(nRows, nCols)
    rng.Value = rnga.Value
End Sub

Answer 1

您过于深入地研究筛选的行，并使用筛选的行数来重新定义筛选的范围。你可以直接从过滤范围复制，只粘贴可见的行。

Sub test()
    Dim wb As Excel.Workbook, fdRng As Range, v As Long, vCOLs As Variant
    Dim sourceWS As Worksheet, destinationWS As Worksheet
    Set wb = ActiveWorkbook
    Set sourceWS = wb.Worksheets("Prepsheet")
    vCOLs = Array(1, 3, 5) 'columns A, C and E
    With sourceWS
        If .AutoFilterMode Then
            With .AutoFilter.Range
                With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                    For v = LBound(vCOLs) To UBound(vCOLs)
                        .Columns(vCOLs(v)).Copy _
                          destination:='YOU HAVE PROVIDED NO DEFINED DESTINATION
                    Next v
                End With
            End With
        End If
    End With
End Sub
Sub MatchSelectionArea()
    Dim rng As Range, cel As Range
    Dim nRows As Long, nCols As Long
    With Worksheets("Contract")
        Set cel = .Range("a1048576").End(xlUp).Offset(1, 0)
        nRows = rnga.Rows.Count
        nCols = rnga.Columns.Count
        'cannot determine what this actually does
        Set rng = cel.Resize(nRows, nCols)
        rng = rnga.Value
    End With
End Sub