copy and paste to next available row above or below existing data

[pogishane]

this is the code i have so far:
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("BDO Pipeline")
Set pasteSheet = Worksheets("UW Pipeline")
copySheet.Range("E3:H3").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheets("UW Pipeline").Select


I delete data from the "UW Pipeline" regularly and would like to have the data that is copied from the "BDO Pipeline" and pasted into "UW Pipeline" to past in the next available row that is open no matter if it is above or below other data. thanks for the help in advance and let me know if you have any other questions.

 

[Jim885]

You weren't far off.
This meets your description;

Sub aa()
 Dim copySheet As Worksheet
 Dim pasteSheet As Worksheet
 Set copySheet = Worksheets("BDO Pipeline")
 Set pasteSheet = Worksheets("UW Pipeline")
 Application.ScreenUpdating = False
 copySheet.Range("E3:H3").Copy
 pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
 Application.CutCopyMode = False
 Application.ScreenUpdating = True
 Sheets("UW Pipeline").Select
End Sub

 

[pogishane]

Thank you for the reply but it just acts like it did before. it just posts to the next empty row at the bottom rather than posting to the next available row that is blank. for example row 1,2,3, and 5 all have data. i want it to post to row 4 rather than row 6.

 

[Jim885]

This will do it;
Paste this into a regular module

Sub aa()
 Dim copySheet As Worksheet
 Dim pasteSheet As Worksheet
 Set copySheet = Worksheets("BDO Pipeline")
 Set pasteSheet = Worksheets("UW Pipeline")
 Dim rngToSearch As Range
 Dim firstblankrownumber As Long
 Dim LR As Long
LR = pasteSheet.Range("A" & Rows.Count).End(xlUp).Row
    Set rngToSearch = pasteSheet.Range("A1:A" & LR + 1)
    firstblankrownumber = FirstBlankRow(rngToSearch)
    
   copySheet.Range("E3:H3").Copy
    pasteSheet.Cells(firstblankrownumber, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False

 Sheets("UW Pipeline").Select
    
End Sub


Function FirstBlankRow(ByVal rngToSearch As Range, Optional activeCell As Range) As Long
Dim FirstBlankCell As Range
    If activeCell Is Nothing Then Set activeCell = rngToSearch.Cells(1, 1)
    'Check if cell isn't empty
    If WorksheetFunction.CountA(rngToSearch.Cells(1, 1).EntireRow) = 0 Then
        FirstBlankRow = rngToSearch.Cells(1, 1).Row
    Else
        Set FirstBlankCell = rngToSearch.FindNext(After:=activeCell)
        If Not FirstBlankCell Is Nothing Then
            If WorksheetFunction.CountA(FirstBlankCell.EntireRow) = 0 Then
                FirstBlankRow = FirstBlankCell.Row
            Else
                Set activeCell = FirstBlankCell
                FirstBlankRow = FirstBlankRow(rngToSearch, activeCell)
            End If
        Else
        End If
    End If
End Function

 

[pogishane]

You sir are AMAZING! thank you!

 

[Jim885]

Thanks for the compliment!
And you're welcome.

Please do me a favor and click the "Like" on the lower right portion of my post# 4 above.

 

[Williamyyyyy]

You weren't far off.
This meets your description;

Sub aa()
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("BDO Pipeline")
Set pasteSheet = Worksheets("UW Pipeline")
Application.ScreenUpdating = False
copySheet.Range("E3:H3").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheets("UW Pipeline").Select
End Sub

What if i doesn’t want to paste value, i wanna paste only. How can i edit it?

 

[Peter_SSs]

What if i doesn’t want to paste value, i wanna paste only. How can i edit it?

Untested, but try this change

copySheet.Range("E3:H3").Copy
pasteSheet.Cells(firstblankrownumber, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues

copySheet.Range("E3:H3").Copy Destination:=pasteSheet.Cells(firstblankrownumber, 1).End(xlUp).Offset(1)