3

我正在做一个小项目，如果我在行中检测到“真”，则需要我复制和粘贴某些列。我正在尝试将这些选定的列粘贴到不同的工作表上，并且我只想粘贴它们的值而不是公式。

这是我到目前为止所拥有的，我在粘贴特殊功能方面遇到了错误。请帮忙。

' CopyIfTrue()
Dim Col As Range, Cell As Excel.Range, RowCount As Integer
Dim nysheet As Worksheet
Set nysheet = Sheets.Add()
nysheet.Name = "T1"

Sheets("FemImplant").Select
RowCount = ActiveSheet.UsedRange.Rows.Count

Set Col = Range("I2:I" & RowCount) 'Substitute with the range which includes your True/False values
Dim i As Integer
i = 1

For Each Cell In Col      
     If Cell.Value = "True" Then                  
        Cell.Copy
        Sheets("T1").Select 'Substitute with your sheet
        Range("b" & i).Select
        ActiveSheet.Paste

        'Get sibling cell

        Sheets("FemImplant").Select
        Dim thisRow As Integer
        thisRow = Cell.Row
        Dim siblingCell As Range
        Set siblingCell = Cells(thisRow, 2)
        siblingCell.Copy
        Sheets("T1").Select 'Substitute with your sheet
        Range("a" & i).Select
        ActiveSheet.PasteSpecial Paste:=xlPasteValues

        Sheets("FemImplant").Select
         i = i + 1
    End If
Next
4

4 回答 4

8

PasteSpecial 必须是 Range.PasteSpecial 而不是 ActiveSheet.PasteSpecial。它们是不同的东西，ActiveSheet.PasteSpecial 不知道任何参数“Paste”。

ActiveSheet.Range("a" & i).PasteSpecial Paste = xlPasteValues
于 2012-06-12T19:56:51.080 回答
2

Is this what you are trying?

Option Explicit

Sub Sample()
    Dim rRange As Range
    Dim RowCount As Integer, i As Long
    Dim nysheet As Worksheet

    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("T1").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set nysheet = Sheets.Add()
    nysheet.Name = "T1"

    With Sheets("FemImplant")
        RowCount = .Range("I" & Rows.Count).End(xlUp).Row

        .AutoFilterMode = False

        Set rRange = .Range("I2:I" & RowCount)

        With rRange
            .AutoFilter Field:=1, Criteria1:="True"

            .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
            nysheet.Range("B1").PasteSpecial xlPasteValues

            .Offset(1, -7).SpecialCells(xlCellTypeVisible).Copy
            nysheet.Range("A1").PasteSpecial xlPasteValues
        End With

        .AutoFilterMode = False
    End With
End Sub
于 2012-06-12T20:23:21.680 回答
0

我相信您提供的代码比以前快得多。但是为了帮助其他人更容易理解，为什么不发表一些评论呢？

我已经为你做到了。

Sub ExtractData()

Dim selectedRange As Range ' Range to check
Dim Cell As Range
Dim iTotalRows As Integer ' Selected total number of rows
Dim i As Integer ' marker to identify which row to paste in new sheet

Dim shtNew As Worksheet
Dim shtData As Worksheet

Set shtData = Sheets("data")
Set shtNew = Sheets.Add()
shtNew.Name = "Analyzed data"

iTotalRows = shtData.UsedRange.Rows.count
Set selectedRange = shtData.Range("F2:F" & iTotalRows)

i = 1

' Check the selected column value one by one
For Each Cell In selectedRange.Cells

     If Cell.Value = "True" Then
        Cell.Copy shtNew.Range("A" & i)

        ' Copy the brand to column B in "Analyzed data" sheet
        shtNew.Range("B" & i).Value = _
                       shtData.Cells(Cell.Row, 2).Value
        i = i + 1
    End If

Next ' Check next cell in selected range

End Sub
于 2013-03-15T04:54:42.830 回答
0

您的复制/粘贴可以大大缩短......

' CopyIfTrue()
Dim Col As Range, Cell As Excel.Range, RowCount As Integer
Dim nysheet As Worksheet, shtFI As Worksheet

Set shtFI = Sheets("FemImplant")
Set nysheet = Sheets.Add()
nysheet.Name = "T1"

RowCount = shtFI.UsedRange.Rows.Count
Set Col = shtFI.Range("I2:I" & RowCount)

Dim i As Integer
i = 1

For Each Cell In Col.Cells
     If Cell.Value = "True" Then
        Cell.Copy nysheet.Range("B" & i)
        nysheet.Range("A" & i).Value = _
                       shtFI.Cells(Cell.Row, 2).Value
        i = i + 1
    End If
Next
于 2012-06-12T20:08:25.727 回答