VBA copy cell data to next empty cell in range

[MeaclH]

Hi all,

I want to run a macro that copies the data in a selected cell, and enters it in the next available cell further down the sheet. If the first cell in the range has data, it will enter it in the next cell below, stacking the data from multiple cells.

For example the first data would be entered in E60, then E61 etc etc

Cheers
Hayden

 

[mohadin]

Hi
Try this in sheet code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Selection) Is Nothing Then
        Me.Range("E" & Me.Cells(Rows.Count, "E").End(xlUp).Row + 1) = Selection.Offset(-1)
    End If
End Sub

 

[MeaclH]

Hi Mohadin,

It didn't seem to work so well, or perhaps I'm a bit too new to this.

Here is the sheet I am working on. I'd like to have a button run a macro that would take the data from the cell selected, and put down the bottom in the area where there is space for Open Shifts.
If the first row of open shifts already has data in it, it will then put it in the cell below, and so on.
Cheers,
Hayden

Digital Roster AUG23.xlsm
	A	B	C	D	E	F	G	H
52	Line 17	Rostered DAO	FEEGRADO.R	Rostered Shift	2130BC	2130PB	2130NCC	2130BC
53		Swapped w/ DAO		Amended Shift
54		Remarks		Shift Extension
55	Line 18	Rostered DAO	REEVES.S	Rostered Shift	0530PB	0530PL	0530CFD	OFF
56		Swapped w/ DAO		Amended Shift
57		Remarks		Shift Extension
58
59			Reliever DAOs
60
61	Reliever 1	Rostered DAO		Rostered Shift
62		Swapped w/ DAO		Amended Shift
63		Remarks		Shift Extension
64	Reliever 2	Rostered DAO		Rostered Shift
65		Swapped w/ DAO		Amended Shift
66		Remarks		Shift Extension
67	Reliever 3	Rostered DAO		Rostered Shift
68		Swapped w/ DAO		Amended Shift
69		Remarks		Shift Extension
70	Reliever 4	Rostered DAO		Rostered Shift
71		Swapped w/ DAO		Amended Shift
72		Remarks		Shift Extension
73
74				Open Shifts
75
76
77
78
79
27AUG23

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E4:R72	Cell Value	contains "PH CREDIT"	text	NO
E4:R72	Cell Value	contains "A/L"	text	NO
80:1048576,A75:C79,E75:XFD79,8:9,A7:B7,11:12,A10:B10,D10:XFD10,14:15,A13:B13,D13:XFD13,17:18,A16:B16,D16:XFD16,20:21,A19:B19,D19:XFD19,23:24,A22:B22,D22:XFD22,26:27,A25:B25,D25:XFD25,29:30,A28:B28,D28:XFD28,32:33,A31:B31,D31:XFD31,35:36,A34:B34,D34:XFD34	Cell Value	contains "CARERS"	text	NO
E4:R72	Cell Value	contains "SICK"	text	NO
E71:R72	Cell Value	contains "edo"	text	NO
E71:R72	Cell Value	contains "OFF"	text	NO
E61:R70	Cell Value	contains "edo"	text	NO
E61:R70	Cell Value	contains "OFF"	text	NO
E56:R59	Cell Value	contains "edo"	text	NO
E56:R59	Cell Value	contains "OFF"	text	NO
E4:R55	Cell Value	contains "edo"	text	NO
E4:R55	Cell Value	contains "OFF"	text	NO

Cells with Data Validation
Cell	Allow	Criteria
C53	List	='Staff List'!$A$1:$A$18
C56	List	='Staff List'!$A$1:$A$18
C68	List	='Staff List'!$A$1:$A$18
C62	List	='Staff List'!$A$1:$A$18
C65	List	='Staff List'!$A$1:$A$18
C71	List	='Staff List'!$A$1:$A$18

 

[mehidy1437]

Still your details & requirement is not so clear.
Your post #1 & #3 are not matching.
Also there are merge cell at row 74 to 79.
Please elaborate more, so someone can understand it better & help you quickly.

 

[MeaclH]

Still your details & requirement is not so clear.
Your post #1 & #3 are not matching.
Also there are merge cell at row 74 to 79.
Please elaborate more, so someone can understand it better & help you quickly.

Sorry yes I may not have been clear enough.

Say I select cell E52. I want to run a macro on that selection that would, copy that data to E74. Then if I did the same with E55 it would copy the data to E75.
It should always start at row 74, and put the data in the first empty cell working downwards.
Hope this clarifies.
Thanks for your help

 

[mehidy1437]

Try this
Select the cell you want copy, then run this code.

Sub CopyToLastRow()
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim activeCell As Range
    
    Set ws = ActiveSheet
    Set activeCell = ActiveCell
    lastRow = ws.Cells(ws.Rows.Count, activeCell.Column).End(xlUp).Row
    lastRow = lastRow + 1
    If lastRow < 74 Then
        lastRow = 74
    End If
    
    activeCell.Copy ws.Cells(lastRow, activeCell.Column)
End Sub

 

[MeaclH]

Try this
Select the cell you want copy, then run this code.

Sub CopyToLastRow()
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim activeCell As Range
   
    Set ws = ActiveSheet
    Set activeCell = ActiveCell
    lastRow = ws.Cells(ws.Rows.Count, activeCell.Column).End(xlUp).Row
    lastRow = lastRow + 1
    If lastRow < 74 Then
        lastRow = 74
    End If
   
    activeCell.Copy ws.Cells(lastRow, activeCell.Column)
End Sub

Thanks Mehidy, I got this message when running the code. "Object variable or With block variable not set"

Any ideas?
Ta

 

[mehidy1437]

Try using this, this should work.

Sub CopyToLastRow()
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim selectCell As Range
   
    Set ws = ActiveSheet
    Set selectCell = activeCell
    
    If selectCell Is Nothing Then
        MsgBox "Please select a cell before running this macro.", vbExclamation
        Exit Sub
    End If
    
    lastRow = ws.Cells(ws.Rows.Count, activeCell.Column).End(xlUp).Row
    lastRow = lastRow + 1
    
    If lastRow < 74 Then
        lastRow = 74
    End If
   
    activeCell.Copy ws.Cells(lastRow, activeCell.Column)
End Sub

 

[MeaclH]

Try using this, this should work.

Sub CopyToLastRow()
    Dim lastRow As Long
    Dim ws As Worksheet
    Dim selectCell As Range
  
    Set ws = ActiveSheet
    Set selectCell = activeCell
   
    If selectCell Is Nothing Then
        MsgBox "Please select a cell before running this macro.", vbExclamation
        Exit Sub
    End If
   
    lastRow = ws.Cells(ws.Rows.Count, activeCell.Column).End(xlUp).Row
    lastRow = lastRow + 1
   
    If lastRow < 74 Then
        lastRow = 74
    End If
  
    activeCell.Copy ws.Cells(lastRow, activeCell.Column)
End Sub

amazing!!! thanks heaps mate. one last thing, is there a way to copy and paste only the cell contents and not the cell formatting also?
legend!

 

[mehidy1437]

Yes, change last line to this.

ws.Cells(lastRow, activeCell.Column).Value = activeCell.Value