Problems with pasting while shifting down cells

Question

Hi I am trying to copy info from a workbook into another workbook and paste while shifting cells down. My problem is that is not pasting the information at all. The code does everything is supposed to except for pasting the rows.

Sub filter_copy_paste()

 Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim whatToFind As String
Dim foundTwo As Range
Dim newSelectionRange As Range
Dim rowSelectionRange As Range
Dim Found_Row As Long
Dim num As Integer
'

Sheets("Sheet1").Select

    whatToFind = "Mean"
    
    Set foundTwo = Cells.Find(What:=whatToFind, After:=ActiveCell, LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
'
Found_Row = foundTwo.row



    With Sheets("Main").Range("A12:S12").CurrentRegion
        .AutoFilter Field:=19, Criteria1:="Yes"
        .SpecialCells(xlCellTypeVisible).EntireRow.Copy
        
        '_
           ' Destination:=Sheets("Sheet1").Range("A1")
'
' I added the following line to insert selection and shift down in Cells above mean
'
             Set rowSelectionRange = Rows(Found_Row - 1).Resize(1)
            rowSelectionRange.Select
             Selection.Insert Shift:=xlDown
    End With
    
'
'Following is added to clean up my previous worksheet
'
    Sheets("Main").Select
        If ActiveSheet.FilterMode = True Then
            ActiveSheet.ShowAllData
        End If
        
    Sheets("Main").Select
    Rows("3:11").Select
    Range("A11").Activate
    Selection.EntireRow.Hidden = True
    Application.CutCopyMode = False
    
    Sheets("Sheet1").Select
    
     Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

I am expecting the copied rows to be inserted in the range above Mean

What does it do instead of copying? Side note: You want to [avoid using Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) in your code. — cybernetic.nomad, Feb 17 '23 at 20:45
It inserts a new blank row instead of inserting the copied rows — ElRafa, Feb 17 '23 at 20:51
The Rows are filtered without any trouble, and they are copied too, once It selects sheet1 (where I want to copy the rows to) it stays copied but it does not paste/insert into the rows. Instead a blank row is inserted — ElRafa, Feb 17 '23 at 20:58
I think you need to [paste](https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.paste) — cybernetic.nomad, Feb 17 '23 at 22:04

score 3 · Accepted Answer · answered Feb 17 '23 at 22:16

3

This should do what you need:

Sub filter_copy_paste()
    
    Const FIND_THIS As String = "mean" 'use const for fixed values
    
    Dim f As Range, numRows As Long, wsSrc As Worksheet, wsDest As Worksheet
   
    Set wsSrc = ThisWorkbook.Worksheets("Main")    'source table
    Set wsDest = ThisWorkbook.Worksheets("Sheet2") 'copy to here
    
    Set f = wsDest.Cells.Find(What:=FIND_THIS, LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
    If f Is Nothing Then
        MsgBox "'" & FIND_THIS & "' not found on " & wsDest.Name, vbExclamation
        Exit Sub
    End If

    With wsSrc.Range("A12:S12").CurrentRegion
        Debug.Print "Data", .Address()
        .AutoFilter Field:=19, Criteria1:="Yes"
        'how many rows will be copied?
        numRows = .Columns(1).SpecialCells(xlCellTypeVisible).Count
        f.Resize(numRows).EntireRow.Insert shift:=xlDown 'insert the rows
        'copy visible rows
        .SpecialCells(xlCellTypeVisible).Copy wsDest.Cells(f.Row - numRows, "A")
    End With
    
    wsSrc.ShowAllData

End Sub

answered Feb 17 '23 at 22:16

Tim Williams

154,628
8
97
125

1

Works correctly (at least that's also what my code is aiming for). Just wanted to ask how does `xlFormulas2` end up being the `LookIn` parameter? I've also seen this in a few other posts. – VBasic2008 Feb 17 '23 at 22:41
1

@VBasic2008 - I just copied the `xlFormulas2` from the OP's code.... Looks like it should be `xlFormulas` though, as `xlFormulas2` is not valid for `LookIn` – Tim Williams Feb 17 '23 at 22:47
1

[Here's a link](https://stackoverflow.com/search?tab=newest&q=%5bvba%5dxlformulas2&searchOn=3) so you don't think I'm full of it. It's spreading like a virus. – VBasic2008 Feb 17 '23 at 22:55
2

@VBasic2008 When I recorded a macro using "look in formulas" it gave me `LookIn:=xlFormulas2` so that explains it maybe. Seems like in versions of Excel which support "dynamic array formulas" `xlFormulas2` has superceded `XlFormulas` – Tim Williams Feb 17 '23 at 23:06
Thank you Tim William, yours was the better route at the end! – ElRafa Feb 18 '23 at 03:55

VBasic2008 · Answer 2 · 2023-02-17T22:38:50.290

Insert Filtered Rows

Sub InsertFilteredRows()

    Application.ScreenUpdating = False
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source
    
    Dim sws As Worksheet: Set sws = wb.Sheets("Main")
    If sws.FilterMode Then sws.ShowAllData
    If sws.AutoFilterMode Then sws.AutoFilterMode = False
    
    Dim srg As Range: Set srg = sws.Range("A12").CurrentRegion
    srg.AutoFilter Field:=19, Criteria1:="Yes"
        Dim svrg As Range: Set svrg = srg.SpecialCells(xlCellTypeVisible)
    sws.AutoFilterMode = False
    
    Dim sarg As Range, srCount As Long
    For Each sarg In svrg.Areas: srCount = srCount + sarg.Rows.Count: Next sarg
    
    'Debug.Print srg.Address, svrg.Address, srCount
    
    ' Destination
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Sheet1")
    If dws.FilterMode Then dws.ShowAllData
    
    Dim durg As Range: Set durg = dws.UsedRange
    Dim dlCell As Range: Set dlCell = durg.Cells(durg.Cells.CountLarge)
    
    ' Starting with the first cell of the used range searching by rows,
    ' attempt to find the first cell that contains the search string.
    ' The search is by default case-insensitive ('A=a').
    Dim dfCell As Range: Set dfCell = dws.Cells.Find( _
        What:="Mean", After:=dlCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows) ' the rest are default parameters
    If dfCell Is Nothing Then Exit Sub ' string not found
    Dim dirg As Range: Set dirg = Intersect(durg, dfCell.EntireRow) _
        .Resize(srCount) ' your code additionally suggests '.Offset(-1)' !?
    
    'Debug.Print svrg.Address, dfCell.Address, dirg.Address
    
    ' Insert and copy.
    
    dirg.Insert Shift:=xlShiftDown
    ' Cannot determine the 'CopyOrigin' parameter without seeing the data.
    
    ' Copy.
    svrg.Copy dirg.Columns(1).Offset(-srCount)
    
    ' Clean up!?
    
    sws.Rows("3:11").Hidden = True
    If Not wb Is ActiveWorkbook Then wb.Activate
    dws.Select
    
    Application.ScreenUpdating = True

    ' Inform.
    
    MsgBox "Filtered rows inserted.", vbInformation

End Sub

Problems with pasting while shifting down cells

2 Answers2

Insert Filtered Rows