# Copy & Paste - Automatically



## SG666 (Dec 28, 2022)

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 (Dec 28, 2022)

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 (Dec 29, 2022)

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 (Dec 29, 2022)

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 (Dec 29, 2022)

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.xlsmABCDEFGHIJ6HeaderHeaderHeaderHeaderHeader72GroundReception600x600Fail841stOffice 1SpotlightFail96RoofRoof AreaBulkeadFailFailures

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 (Dec 29, 2022)

HaHoBe said:


> 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?
> 
> ...



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 (Dec 29, 2022)

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 (Dec 29, 2022)

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 (Dec 29, 2022)

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 (Dec 29, 2022)

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


----------



## SG666 (Dec 28, 2022)

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 (Dec 29, 2022)

Hi SG666,

on sheet _Report_ the first line of entries is 10, Column to check is _"J"_, entry must be _"Fail"_ (I changed the value to be lower case _"fail"_), first line on sheet _Failures_ will be the first free row as that is a variable which will be calculated on each run.

You would need to give us information about where the data is located (row number and columns to copy) and what the contents of the first row are.

Holger


----------



## SG666 (Dec 29, 2022)

Hi,

Sorry this is probably taking longer then you might have hoped.

I have duplicated the Reports WS so that the Failures WS looks exactly the same, so in theory the items that disappear from "Reports" should reappear in the available rows within "Failures" (i have removed the original Failures to avoid conflicts), however this still doesn't work. They will disappear from Reports, but wont appear on Failures.

The below screengrab shows the kind of data that will be input, you can see that this is within the WS "Reports", the result column is empty at present but its  a dropdown list that allows the choice of either Pass or Fail.

If i choose Fail from row 10, column J it will disappear from that worksheet, but nothing happens on the other worksheet. 



 



I hope this helps, and thank you so far for you help and patience!


----------



## HaHoBe (Dec 29, 2022)

Hi SG666,

please find my sample workbook here where you can check after download if the procedure is triggered once any status on Report is changed to Fail.

Ciao,
Holger


----------



## SG666 (Dec 30, 2022)

Thanks for this, seems to work perfectly!

How hard is it to change the code to get it to only copy on the data from the Report to the Failures and not delete it after?


----------



## HaHoBe (Dec 30, 2022)

Hi SG666,

instead of


```
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
```

which will delete either comment the lines 


```
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
```

or delete the commented lines. I would take a different route here to opt for both possibilties by using a Boolean to determine whether to delete or not like


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

Const cblnKeep As Boolean = True      'True means keep Data, False will delete

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
    If Not cblnKeep Then
      Application.EnableEvents = False
      Range("A" & Target.Row & ":J" & Target.Row).Delete
      Application.EnableEvents = True
    End If
    Set wsFailures = Nothing
  End If
End If

End Sub
```

Ciao,
Holger


----------



## SG666 (Dec 30, 2022)

This is great thanks!

So am I right in thinking if i use the last example (with the Boolean) I can change the below from either True (to keep the data that has been copied) or False (to delete it once its been copied) ?

*Const cblnKeep As Boolean = True*


----------



## HaHoBe (Dec 30, 2022)

Hi SG666,

you're right on this.

Holger


----------

