Question

我有一个可以工作的VBA宏，它可以从一个电子表格中复制出平均值＆＃39; AverageEarnings＆＃39;在另一个＆＃39; Sheet1＆＃39;，条件是AO列中有单词＆＃39; UNGRADED＆＃39;在里面。宏将整个这些条件行复制到Sheet1。我希望将B列和C列（＆＃39; AverageEarnings＆＃39;）复制到A列和B列（＆＃39; Sheet1＆＃39;）。我该如何修改呢。

 Sub UngradedToSHEET1()

' UngradedToSHEET1 Macro
'
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim copyFrom As Range
    Dim lRow As Long
    Dim stringToFind As String

    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Worksheets("AverageEarnings")

    stringToFind = "UNGRADED"

    With ws1
        'Remove all filters from spreadsheet to prevent loss of information.
        .AutoFilterMode = False
        lRow = .Range("AO" & .Rows.Count).End(xlUp).Row 'Find a specific column.

        With .Range("AO1:AO" & lRow) ' This is the row where GRADED or UNGRADED is specified.
            .AutoFilter Field:=1, Criteria1:="=*" & stringToFind & "*" 'Filter specific information.
            Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With

        'Remove spreadsheet filters again.
        .AutoFilterMode = False
    End With

    Set ws2 = wb1.Worksheets("Sheet1")

    With ws2
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then    ' Find a blank row after A1.
            lRow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lRow = 1
        End If
        copyFrom.Copy .Rows(lRow)
    End With
End Sub

Answer 1

此行复制整行：

Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow

您需要更改EntireRow以复制所需的列，可能是：

Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Range(.Cells(1,2),.Cells(1,3))

希望这有帮助，我现在无法检查。

复制某些列VBA

1 个答案: