VBA - Copy insert code is adding row.

[Lburch01]

Hi
I have below code that filters in Sheet 1, deletes results then copies the remaining rows and inserts into sheet 2. The problem is it is leaving a blank row every time it inserts. Anyone have any ideas?

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With srcWS
        .Range("A1").CurrentRegion.AutoFilter 22, 1
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .Range("A1").AutoFilter
        .UsedRange.Offset(1).Copy
        desWS.Range("a1").Insert
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[veyselemre]

Hi,

        .UsedRange.Offset(1).Copy

instead, write this

        .UsedRange.Offset(1).Resize(.UsedRange.Rows.Count - 1).Copy

 

[Lburch01]

Thanks mate that worked

 

[Lburch01]

Is it possible to copy paste on first blank row in sheet 2. I am having trouble with Formulas and a copy paste values will be better than insert.

 

[veyselemre]

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, desWS As Worksheet

    Set desWS = Sheets("Sheet2")
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    With Sheets("Sheet1")
        If .AutoFilterMode = False Then .Rows(1).AutoFilter
        .Range("A1").CurrentRegion.AutoFilter 22, 1
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilter.ShowAllData
        .UsedRange.Offset(1).Resize(.UsedRange.Rows.Count - 1).Copy desWS.Cells(LastRow + 1, 1)
    End With

    Application.ScreenUpdating = True
End Sub

 

[Lburch01]

Hi yeah that is inserting at the top of sheet 2. I am hoping for it to paste values at the bottom of populated rows in sheet 2.

 

[Lburch01]

So sorry Veyselemre it worked great
Am i allowed to ask 1 more.
I have formulas that i need to paste in column V in sheet1.
But i only want to paste down to last populated row. How would i do that?

 

[veyselemre]

I don't fully understand what you want to do. Pastes a formula into the empty cells in column V.
If this is your request, it may be necessary to make adjustments according to the formula you will write.

Sub test()

    With Sheets("Sheet1")
        If .AutoFilterMode = False Then .Rows(1).AutoFilter
        .Range("A1").CurrentRegion.AutoFilter 22, ""
        Intersect(.AutoFilter.Range.Offset(1).Resize(.UsedRange.Rows.Count - 1), [V:V]).Formula = "=MOD(ROW(),2)"
        .AutoFilter.ShowAllData
    End With

End Sub

or

Sub test2()
    Dim LastRow As Long

    With Sheets("Sheet1")
        LastRow = .Cells(Rows.Count, 1).End(3).Row
        With .Range("V2:V" & LastRow)
            If WorksheetFunction.CountBlank(.Cells) > 0 Then
                .SpecialCells(xlCellTypeBlanks).Formula = "=MOD(ROW(),2)"
            End If
        End With
    End With

End Sub

 

[Lburch01]

Hi, I would like the add formula function added to code above please. How could we do this?

So it will be
Copy Sheet 3 W35:Z35 (formulas)
Paste in sheet 1 Column W from first row all the way down to last row
Copy column W:Z
Paste values in same place
Filter column V for value 1
Delete
Insert all value range into sheet 2 (at bottom of last populated row).

 

[veyselemre]

Hi,
Try this.

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, desWS As Worksheet

    Set desWS = Sheets("Sheet2")
    LastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    With Sheets("Sheet1")
        .Range("W2:Z" & .Cells(Rows.Count, 1).End(3).Row).Formula = Sheets("Sheet3").Range("W35:Z35").Formula
        If .AutoFilterMode = False Then .Rows(1).AutoFilter
        .Range("A1").CurrentRegion.AutoFilter 22, 1
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilter.ShowAllData
        .UsedRange.Offset(1).Resize(.UsedRange.Rows.Count - 1).Copy desWS.Cells(LastRow + 1, 1)
        .AutoFilterMode = False
    End With

    Application.ScreenUpdating = True
End Sub