paste special values in vba

后端 未结 4 1591
太阳男子
太阳男子 2021-01-20 22:54

I am working on a small project which requires me to copy and paste certain columns if I detect \"true\" in the row. I am trying to paste these selected columns onto a diffe

相关标签:
4条回答
  • 2021-01-20 23:07

    Your copy/paste can be shortened considerably...

    ' 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
    
    0 讨论(0)
  • 2021-01-20 23:12

    I believe the code you provided is much faster than earlier. However to help other understand easier, why not put some comment?

    I have done that for you.

    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
    
    0 讨论(0)
  • 2021-01-20 23:26

    PasteSpecial must be Range.PasteSpecial not ActiveSheet.PasteSpecial. They are different things and ActiveSheet.PasteSpecial does not know any parameter "Paste".

    ActiveSheet.Range("a" & i).PasteSpecial Paste = xlPasteValues
    
    0 讨论(0)
  • 2021-01-20 23:29

    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
    
    0 讨论(0)
提交回复
热议问题