CODEWITHSUNDEEP
excelvbacopy-paste
M9933
M9933

Reputation: 31

Excel VBA Paste Values to first blank row

I'm trying to set up an excel macro VBA that does the following:

Copies the value from B16 and paste it as value to the first blank row below B26. (So if B26, B27 are not blank, would paste the value to B28).

At the same time it also copies the value from A16 and pastes in the same row but in the A column, and same with C16 copying value and paste together with other values in column C.

So if B26, B27, and B28 are full. The VBA would copy values from A16, B16, and C16 and paste them to the first available row of corresponding columns (in the example, it would be A29, B29 and C29.

Upvotes: 3

Views: 1536

Answers (1)

VBasic2008
VBasic2008

Reputation: 54777

Copy Values to First Empty Cell's Row

  • Starting from cell B26 (inclusive) towards the bottom, it will try to find an empty cell. If found, it will copy the values from the range A16:C16 to the found cell's row of the same columns.
Option Explicit

Sub CopyToFirstEmptyCell()
    
    Const sAddress As String = "A16:C16"
    Const dAddress As String = "B26"
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Reference the source range.
    Dim srg As Range: Set srg = ws.Range(sAddress)
    
    ' Reference the first empty cell below the given cell (inclusive).
    Dim dfCell As Range
    With ws.Range(dAddress) ' from the first cell...  ("B26:B1048576")
        With .Resize(ws.Rows.Count - .Row + 1) ' ...  to the bottom-most cell
            Set dfCell = .Find("", .Cells(.Cells.Count), xlFormulas, xlWhole)
            If dfCell Is Nothing Then ' no cells are empty; highly unlikely
                MsgBox "No empty cells.", vbCritical
                Exit Sub
            End If
        End With
    End With
    
    ' Reference the destination range.
    Dim drg As Range: Set drg = srg.EntireColumn.Rows(dfCell.Row)
    ' srg                                "A16:C16"
    ' srg.EntireColumn                   "A:C"
    ' srg.EntireColumn.Rows(dfCell.Row)  "AdfCell.Row:CdfCell.Row"
    
    ' Copy values by assignment.
    drg.Value = srg.Value

End Sub

Upvotes: 1

Related Questions