Question

我有以下代码，将所有可见数据从“Prepsheet”传输到“Contract”。

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

我想引用过滤区域中的特定列，以便我可以单独传输列特定数据。例如，我可能只想转移第1列和第6列。请有人协助

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

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

1 个答案: