Copy row to another sheet, depending on cell value

Mikael_L

New Member
Joined
Mar 29, 2021
Messages
14
Office Version
  1. 365
Platform
  1. Windows
Hi All,

I'm looking for a VBA code to complete my inputform.

I would like to when the macro is played, to cut the data in C9:Q9 in the sheet nammed inputform, to the next empty row in the sheet name selceted in cell C6.

So I would like to be able to choose which sheet the data is cut into by choosing the sheet name from a dropdown with the diffrent sheet names, eg. S01, S02, S03 etc.

So I found something like this I imagine would work.
But don't know how to adjust it to pick up the target sheet from cell C6 (in the inputform sheet)

Sub CutToSection()
Dim NextRow As Range
Set NextRow = Range("B" & Sheets("Sheet3").UsedRange.Rows.Count + 1)
Inputform.Range("C9:I14").Copy
Sheet3.Activate
NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
Application.CutCopyMode = False
Set NextRow = Nothing
End Sub


Anyone who can help?
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
try this on a copy of your file.

VBA Code:
Sub move_it()

Dim rs As Worksheet
Set rs = Sheets(CStr(ActiveSheet.Range("C6").Value))
lr = rs.Range("A" & Rows.Count).End(xlUp).Row + 1

rs.Range("A" & lr & ":O" & lr).Value = Range("C9:Q9").Value
Range("C9:Q9").ClearContents

End Sub

hth,

Ross
 
Upvote 0
Solution
try this on a copy of your file.

VBA Code:
Sub move_it()

Dim rs As Worksheet
Set rs = Sheets(CStr(ActiveSheet.Range("C6").Value))
lr = rs.Range("A" & Rows.Count).End(xlUp).Row + 1

rs.Range("A" & lr & ":O" & lr).Value = Range("C9:Q9").Value
Range("C9:Q9").ClearContents

End Sub

hth,

Ross

Hi Ross,
Works like a charm, thanks!

Couple of add-ons if possible :).

1) If any of the cells in the input form is left blank, could it then return a fault message box, saying something like "No blank cells allowed" ?

2) How about if the macro needs to unprotect and protect the input- and target sheet before and after the cut/paste function?
 
Last edited:
Upvote 0
VBA Code:
Sub move_it()

Dim rs As Worksheet
Set rs = Sheets(CStr(ActiveSheet.Range("C6").Value))
lr = rs.Range("A" & Rows.Count).End(xlUp).Row + 1

If WorksheetFunction.CountBlank(Range("C9:Q9")) > 0 Then
    MsgBox "You have empty data. Nothing Copied"
    Exit Sub
End If

rs.Unprotect Password:="myPassword"
ActiveSheet.Unprotect Password:="myPassword"

rs.Range("A" & lr & ":O" & lr).Value = Range("C9:Q9").Value
Range("C9:Q9").ClearContents

rs.Protect Password:="myPassword"
ActiveSheet.Protect Password:="myPassword"


End Sub
 
Upvote 0
VBA Code:
Sub move_it()

Dim rs As Worksheet
Set rs = Sheets(CStr(ActiveSheet.Range("C6").Value))
lr = rs.Range("A" & Rows.Count).End(xlUp).Row + 1

If WorksheetFunction.CountBlank(Range("C9:Q9")) > 0 Then
    MsgBox "You have empty data. Nothing Copied"
    Exit Sub
End If

rs.Unprotect Password:="myPassword"
ActiveSheet.Unprotect Password:="myPassword"

rs.Range("A" & lr & ":O" & lr).Value = Range("C9:Q9").Value
Range("C9:Q9").ClearContents

rs.Protect Password:="myPassword"
ActiveSheet.Protect Password:="myPassword"


End Sub

Hi Ross,

Great, Thanks!
But the password seems to work only partly, as I have to run the macro twice to get it to work.

At first run it seems like it's only unprotect the inputform sheet, and it ends up at the target sheet still protected.
If I then go back to the inputform sheet and run the macro again it moves the data and perfectly protect both the input- and the target sheet again.
 
Upvote 0
Hi Ross,

Do you have any suggestions to why the unprotect/protect is not working 100%?

Thanks


/Mikael
 
Upvote 0
hi i am looking for the same thing and I just cant seem to get mine to work, I need to move my row based on it being "taken" but I can't get the code modified to work. can someone please help.

this is the code I am using

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("Q:Q")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target = "Taken" Then
Target.EntireRow.Copy Sheets("CoveredShifts").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Target.EntireRow.Delete
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


Current Date:ClientLocationRGN/HCAShift TimesDay/NightMale/FemaleDuty TypeShift DatesPriorityFloor/AreaStatus
19/05/2021Aughnacloy HouseLurganHCA20:00 - 08:00Night shiftF1-1 AA19/05/20211TAKEN
22/05/2021Aughnacloy HouseLurganHCA20:00 - 08:00Night shiftF1-1 AA22/05/20212
23/05/2021Aughnacloy HouseLurganHCA20:00 - 08:00Night shiftF1-1 AA23/05/20213
23/05/2021Aughnacloy HouseLurganHCA20:00 - 08:00Night shiftM1-1 AA
 
Upvote 0
VBA Code:
Sub move_it()

Dim rs As Worksheet
Set rs = Sheets(CStr(ActiveSheet.Range("C6").Value))
lr = rs.Range("A" & Rows.Count).End(xlUp).Row + 1

If WorksheetFunction.CountBlank(Range("C9:Q9")) > 0 Then
    MsgBox "You have empty data. Nothing Copied"
    Exit Sub
End If

rs.Unprotect Password:="myPassword"
ActiveSheet.Unprotect Password:="myPassword"

rs.Range("A" & lr & ":O" & lr).Value = Range("C9:Q9").Value
Range("C9:Q9").ClearContents

rs.Protect Password:="myPassword"
ActiveSheet.Protect Password:="myPassword"


End Sub

Hi Ross,

I figured out why the unproctect where messing with me, I had to swith the order of when it unprotected the different sheets :). So ActiveSheet.Unprotect Password:="myPassword" had to be above rs.Unprotect Password:="myPassword".

But another "funny" issue.. When the macro has run and it returns to the Input sheet, I cannot see which cell is marked, the green border of the cell is missing, I can type into the selceted cell, just not see it is selected.. But if change sheet and return to the input sheet, the green border is back..


BR
Mikael
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,240
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top