вставить специальные значения в VBA

Я работаю над небольшим проектом, который требует от меня скопировать и вставить определенные столбцы, если я обнаружу & quot; true & quot; в ряд. Я пытаюсь вставить эти выбранные столбцы на другой лист, и я хочу вставить только их значения, а не формулы.

Это то, что у меня есть, и я получаю сообщение об ошибке с помощью специальной функции вставки. Пожалуйста помоги.

' 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
 Siddharth Rout12 июн. 2012 г., 22:10
@ user1452091: Я бы рекомендовал использовать автофильтр вместо циклического прохождения каждого ряда. Это было бы намного быстрее & quot;)
 Ken White12 июн. 2012 г., 21:55
Что значит "получить ошибку"? имею в виду? Когда вы набираете слова «ошибка»,very next thing Вы должны начать печатать - это ошибка, которую вы получаете, дополнивexact сообщение об ошибке с любыми адресами памяти. Мы не можем видеть ваш экран с того места, где мы находимся, и предоставление информации об ошибке значительно облегчает получение ответа. & quot; получить ошибку & quot; без подробностей абсолютно бесполезно для людей, не сидящих за вашим столом. :-) Пожалуйста, отредактируйте ваш вопрос и предоставьте эти детали, чтобы мы могли помочь вам решить вашу проблему. Благодарю.

Ответы на вопрос(4)

что предоставленный вами код работает намного быстрее, чем раньше. Однако, чтобы помочь другим понять легче, почему бы не оставить комментарий?

Я сделал это для тебя.

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

а не ActiveSheet.PasteSpecial. Это разные вещи, и ActiveSheet.PasteSpecial не знает ни одного параметра & quot; Вставить & quot ;.

ActiveSheet.Range("a" & i).PasteSpecial Paste = xlPasteValues

' 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

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

Ваш ответ на вопрос