Question : Copy Entire Row and Paste into a new Worksheet Excel VBA

Hi there,

Hoping someone can assist with the code below. I am new at VBA and have been researching ways to achieve this on the net and this is what I have thus far.

Sub SendtoStorage()
Dim LastRow as Integer
LastRow = Sheets("ResultsLog").Range("B" & Rows.Count).End(xlUp).Select

'Copy Entire Row'
If c Is Nothing Then
LastRow = LastRow + 1
olData.EntireRow.Copy _
Destination:=Sheets("Storage").Range("A" & LastRow)
End If
Next
End With

I am trying to copy the entire row from Sheet "ResultsLog", Range "B4:Y253" if the rows are populated. I want the rows to be copied to the destination sheet "Storage" starting in A2. Data will continually be added to this so it must find the next empty row and paste the data in column A etc.
Once this data has been copied, it needs to clear the contents in "ResultsLog", Range"B4:Y253".

Hope this makes sense. I'm sure I'm totally incorrect with my code, but really did try to give it a go. When I use the recorder it doesn't work.

Answer : Copy Entire Row and Paste into a new Worksheet Excel VBA

This code will work for what you want, I can change it to look for more blank values, right now it only it checks to see if the values in column B are blank. I have attached some test data with random blank cells in column B. The macro assumes you have a column header on the storage sheet.

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:



Sub checkForValue()

Dim currentSheet As Worksheet, ws As Worksheet
Dim currentSelection As Range, target As Range, subTarget As Range
Dim screenUpdate As Boolean

screenUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False

'the program records the current worksheet and current selection
'so at the end of the program you can have the program go back to
'where you were originally
Set currentSheet = Application.ActiveSheet
Set currentSelection = Application.Selection
Set target = Range("B4:B253")

For Each subTarget In target
    If subTarget.Value <> "" Then
        Range(subTarget, subTarget.End(xlToRight)).Copy
        Worksheets("Storage").Select
        Range("A1").Activate
                
        'check to see if the cell A2 is blank, if it is not blank then
        'essentially press Crtl + down arrow to dynamically find the last cell
        If ActiveCell.Offset(1, 0).Value <> "" Then
            Selection.End(xlDown).Select
        End If
                
        'offset the address of the active cell by 1 row and then paste,
        'if you did not do this you would overwrite the old values
        ActiveCell.Offset(1, 0).Activate
        'paste everything
        ActiveCell.PasteSpecial xlPasteAll
        Worksheets("ResultsLog").Select
    End If
Next

Application.CutCopyMode = False
currentSheet.Select
currentSelection.Select

Application.ScreenUpdating = ScreenUpdating

Set currentSheet = Nothing
Set ws = Nothing
Set currentSelection = Nothing
Set target = Nothing
Set subTarget = Nothing

End Sub