Copy & Paste - Automatically

[SG666]

Hi all,

I know this has come up a million times before, and I have search for the answer and seemed to find some, but when I try to use the code it doesn't seem to work for me, as it deletes the original row or wont paste into the correct area on my second worksheet.

What I'd like to do is be able to fill in the below example, and when i choose FAIL it will copy the entire row into the next available row on the Failures worksheet

So that the above "test" would result in a failure list as per the below example...

This is the code that I'd found online to try and edit to fit my needs but I'm struggling to get it to work with my VERY basic knowledge of macros....

Sub MoveBasedonValue()

Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long

A = Worksheets("master").UsedRange.Rows.Count
B = Worksheets("completed").UsedRange.Rows.Count

If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("completed").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("master").Range("D1:D" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = "Done" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("completed").Range("A" & B + 1)
xRg(C).EntireRow.Delete
If CStr(xRg(C).Value) = "Done" Then
C = C - 1
End If
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub


Any help with getting this working would be fantastic and greatly appreciated!!

Thanks,
Shwan

 

[HaHoBe]

Hi SGG66,

do yourself one big favour and get rid of merged cells.

Maybe

Public Sub MrE_1225566_1616A12()
' https://www.mrexcel.com/board/threads/copy-paste-automatically.1225566/
Dim lngWrite As Long
Dim lngCounter As Long
Dim wsMaster As Worksheet
Dim wsCompl As Worksheet

Set wsMaster = ThisWorkbook.Worksheets("master")
Set wsCompl = ThisWorkbook.Worksheets("completed")

With wsMaster
  Application.ScreenUpdating = False
  For lngCounter = .Cells(.Rows.Count, "J").End(xlUp).Row To 10 Step -1
    If LCase(.Cells(lngCounter, "J").Value) = "fail" Then
      lngWrite = wsCompl.Range("A" & wsCompl.Rows.Count).End(xlUp).Row + 1
      wsCompl.Range("A" & lngWrite & ":J" & lngWrite).Value = .Range("A" & lngCounter & ":J" & lngCounter).Value
      .Range("A" & lngCounter & ":J" & lngCounter).Delete
    End If
  Next lngCounter
  Application.ScreenUpdating = True
End With

Set wsCompl = Nothing
Set wsMaster = Nothing
End Sub

Ciao,
Holger

 

[HaHoBe]

Hi SGG66,

the above macro will reverse the order of the data being copied as it starts at the bottom and works up to the first set. The following code will copy over correctly and dekete the range after the copying is finished:

Public Sub MrE_1225566_1616A12_02()
' https://www.mrexcel.com/board/threads/copy-paste-automatically.1225566/
' Updated: 20221229
' Reason:  copy data over keeping order from first list, delete range afterwards
Dim lngWrite As Long
Dim lngCounter As Long
Dim rngDel As Range
Dim wsMaster As Worksheet
Dim wsCompl As Worksheet

Set wsMaster = ThisWorkbook.Worksheets("master")
Set wsCompl = ThisWorkbook.Worksheets("completed")

With wsMaster
  Application.ScreenUpdating = False
  For lngCounter = 10 To .Cells(.Rows.Count, "J").End(xlUp).Row
    If LCase(.Cells(lngCounter, "J").Value) = "fail" Then
      lngWrite = wsCompl.Range("A" & wsCompl.Rows.Count).End(xlUp).Row + 1
      wsCompl.Range("A" & lngWrite & ":J" & lngWrite).Value = .Range("A" & lngCounter & ":J" & lngCounter).Value
      If rngDel Is Nothing Then
        Set rngDel = .Range("A" & lngCounter & ":J" & lngCounter)
      Else
        Set rngDel = Union(rngDel, .Range("A" & lngCounter & ":J" & lngCounter))
      End If
    End If
  Next lngCounter
  Application.ScreenUpdating = True
End With

If Not rngDel Is Nothing Then
  rngDel.Delete
  Set rngDel = Nothing
End If
Set wsCompl = Nothing
Set wsMaster = Nothing
End Sub

Ciao,
Holger

 

[SG666]

Hi Holger,

Thanks for getting back to me. I have used the 2nd code that you posted and had to change the worksheet names as the screenshot i gave was different to the coding i posted so apologies for the confusion.

This is how it looks now, i can get it to remove the items from the first worksheet (Report) but they don't appear on the second worksheet (Failures). I should have mentioned, if there is a way to have this macro running so that as soon as one of our staff enters "FAIL" into the result column it will automatically copy the row onto the failure worksheet.


Dim lngWrite As Long
Dim lngCounter As Long
Dim rngDel As Range
Dim wsReport As Worksheet
Dim wsFailures As Worksheet

Set wsReport = ThisWorkbook.Worksheets("Report")
Set wsFailures = ThisWorkbook.Worksheets("Failures")

With wsReport
Application.ScreenUpdating = False
For lngCounter = 10 To .Cells(.Rows.Count, "J").End(xlUp).Row
If LCase(.Cells(lngCounter, "J").Value) = "fail" Then
lngWrite = wsFailures.Range("A" & wsFailures.Rows.Count).End(xlUp).Row + 1
wsFailures.Range("A" & lngWrite & ":J" & lngWrite).Value = .Range("A" & lngCounter & ":J" & lngCounter).Value
If rngDel Is Nothing Then
Set rngDel = .Range("A" & lngCounter & ":J" & lngCounter)
Else
Set rngDel = Union(rngDel, .Range("A" & lngCounter & ":J" & lngCounter))
End If
End If
Next lngCounter
Application.ScreenUpdating = True
End With

If Not rngDel Is Nothing Then
rngDel.Delete
Set rngDel = Nothing
End If
Set wsFailures = Nothing
Set wsReport = Nothing
End Sub

 

[HaHoBe]

Hi SGG66,

you mention that the items do not appear in the sheets Failure. Is the format identical on both sheets? Is there any information from the system regarding why data is not copied?

This is what my sample worksheet Failure looks like after the macro has run:

MrE_1225566_1616A12_copy paste automatic_221228.xlsm
	A	B	C	D	E	F	G	H	I	J
6	Header	Header	Header				Header			Header
7	2	Ground	Reception				600x600			Fail
8	4	1st	Office 1				Spotlight			Fail
9	6	Roof	Roof Area				Bulkead			Fail
Failures

Regarding the automatic: if the users enter a value or change it directly or you have a list in DataValidation you may try something like this (Right-Click on Sheet Report and choose View Code to get to the relevant code module):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngWrite As Long
Dim wsFailures As Worksheet

If Target.Cells.Count > 1 Then Exit Sub
If Target.Row < 10 Then Exit Sub

If Not Intersect(Target, Columns("J:J")) Is Nothing Then
  If LCase(Target.Value) = "fail" Then
    Set wsFailures = Worksheets("Failures")
    lngWrite = wsFailures.Range("A" & wsFailures.Rows.Count).End(xlUp).Row + 1
    wsFailures.Range("A" & lngWrite & ":J" & lngWrite).Value = Range("A" & Target.Row & ":J" & Target.Row).Value
    Application.EnableEvents = False
    Range("A" & Target.Row & ":J" & Target.Row).Delete
    Application.EnableEvents = True
    Set wsFailures = Nothing
  End If
End If

End Sub

The area to work on is restricted to Column J starting at row 10, and any change for more than one cell will not trigger the event.

Holger

 

[SG666]

Hi SGG66,

you mention that the items do not appear in the sheets Failure. Is the format identical on both sheets? Is there any information from the system regarding why data is not copied?

This is what my sample worksheet Failure looks like after the macro has run:

MrE_1225566_1616A12_copy paste automatic_221228.xlsm
	A	B	C	D	E	F	G	H	I	J
6	Header	Header	Header				Header			Header
7	2	Ground	Reception				600x600			Fail
8	4	1st	Office 1				Spotlight			Fail
9	6	Roof	Roof Area				Bulkead			Fail
Failures

Regarding the automatic: if the users enter a value or change it directly or you have a list in DataValidation you may try something like this (Right-Click on Sheet Report and choose View Code to get to the relevant code module):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngWrite As Long
Dim wsFailures As Worksheet

If Target.Cells.Count > 1 Then Exit Sub
If Target.Row < 10 Then Exit Sub

If Not Intersect(Target, Columns("J:J")) Is Nothing Then
  If LCase(Target.Value) = "fail" Then
    Set wsFailures = Worksheets("Failures")
    lngWrite = wsFailures.Range("A" & wsFailures.Rows.Count).End(xlUp).Row + 1
    wsFailures.Range("A" & lngWrite & ":J" & lngWrite).Value = Range("A" & Target.Row & ":J" & Target.Row).Value
    Application.EnableEvents = False
    Range("A" & Target.Row & ":J" & Target.Row).Delete
    Application.EnableEvents = True
    Set wsFailures = Nothing
  End If
End If

End Sub

The area to work on is restricted to Column J starting at row 10, and any change for more than one cell will not trigger the event.

Holger

Hmm, originally the only difference was that the information that needed to be pasted into WS2 - Failures was starting at row 7 and not row 10 like WS1 - Report. I changed the spreadsheet slightly to see if that would help but it doesn't seem to change anything.

The below screenshots show that they are the same now in terms of rows and columns

The code you just posted for the automatic moving of rows, does this get pasted into the sheet 1 code area, or into the module 1 code box (which is where the original code is?

 

[HaHoBe]

Hi SGG66,

I set up the sheets according to your pictures in the opening post where the target area to copy to an Failures starts with row 6.

Code goes behind the sheet which shall trigger the event:

Ciao,
Holger

 

[SG666]

Perfect thanks, the automation part works a treat now.

I have reverted my failure sheet to how it was, but the date is still disappearing, Any thoughts? Its not due to the fact i have merged cells and you don't is it?

 

[HaHoBe]

Hi SG666,

you mention a date but in the sample pictures no date is mentioned. Can you tell us in which column the date shoiuld be transferred and where it should come from?

Ciao,
Holger

 

[SG666]

Hi,

Sorry I wrote date, but meant data . The data from the row on my first worksheet is still not showing up on the second worksheet