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

Question

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

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

' 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 

Answer 1

PasteSpecial должен быть Range.PasteSpecial not ActiveSheet.PasteSpecial. Это разные вещи, а ActiveSheet.PasteSpecial не знает ни одного параметра «Вставить».

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

Answer 2

Ваша копия/паста может быть значительно сокращен ...

' 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 

Answer 3

Это то, что вы пытаетесь?

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 

Answer 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