Copying entire row from multiple worksheets to one target worksheet using a command button

Uhtred Bebbanburg · Apr 15, 2023

I'm trying to copy select rows from multiple sheets only when the value in column B is "Y".

I need to do this from multiple worksheets to one target worksheet without overwriting the values e.g. it will check for the last row that has a value and put the new entry in the row below.

I have managed to get this to work based on entering the "Y" value in column B of a particular worksheet. Code for this is:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errhandler
Application.EnableEvents = False

lastrow = Sheets("Change Tracker 2").Cells(Rows.Count, "A").End(xlUp).Row

If Target.Column = 2 And UCase(Target.Value) = "Y" Then
Cells(Target.Row, Target.Column).EntireRow.Copy Destination:= _
Sheets("Change Tracker 2").Range("A" & lastrow + 1).End(xlUp).Offset(1)
End If
errhandler:
Application.EnableEvents = True
End Sub
However the problem with this is if updates are made to the active sheet that is being copied from after the "Y" has been entered in column B for that row these changes won't show up in the target sheet that is being copied to, that sheet being "Change Tracker 2".
I therefore want to modify this code to work with a command button that can run through multiple named worksheets and copy the rows in the same fashion collating them all into the "Change Tracker 2" worksheet. Will also clear all the values from the "Change Tracker 2" worksheet before it does this so basically when the user wants to the can collate all of the rows that meet the criteria by pressing the button and they are all up to date.
Have tried this but don't know how to set the worksheets to copy from. Code I have so far is:

Sub Button2_Click()

On Error GoTo errhandler
Application.EnableEvents = False

lastrow = Sheets("Change Tracker 2").Cells(Rows.Count, "A").End(xlUp).Row

Set WorkRng = Sheets("General").Range("A7:M105")

If Target.Column = 2 And UCase(Target.Value) = "Y" Then
Cells(Target.Row, Target.Column).EntireRow.Copy Destination:= _
Sheets("Change Tracker 2").Range("A" & lastrow + 1).End(xlUp).Offset(1)
End If
errhandler:
Application.EnableEvents = True
End Sub

As you can see I've attempted (and failed) to set the working sheet to copy from but only one, will need multiple and haven't added the clear function for the sheet yet (though I should be able to manage this at least)

Hope this makes sense and if anyone can help would be much appreciated.

kevin9999 · Apr 15, 2023

Back to the drawing board I think. What are the names of the sheets you want to copy from, and do they all have the same structure? Do they all have header rows, and what row is that on. Does the data start from row 7 or 8 on each sheet (I notice you specify Set WorkRng = Sheets("General").Range("A7:M105")) on your new code. Do you want the rows deleted after they've been copied or left in place. It would help those trying to help you if you could provide samples of your data using the XL2BB - Excel Range to BBCode

Uhtred Bebbanburg · Apr 16, 2023

kevin9999 said:
Back to the drawing board I think. What are the names of the sheets you want to copy from, and do they all have the same structure? Do they all have header rows, and what row is that on. Does the data start from row 7 or 8 on each sheet (I notice you specify Set WorkRng = Sheets("General").Range("A7:M105")) on your new code. Do you want the rows deleted after they've been copied or left in place. It would help those trying to help you if you could provide samples of your data using the XL2BB - Excel Range to BBCode

Thanks so much for your response. Understand more detail is needed and will try and be as thorough as possible. Details below:

There are 5 sheet I want to copy the entire row from to Collate into the "Change Tracker 2" sheet. I do not want to delete the source data. The use case is a follows:

- User wants to collate all of the rows marked as "Y" in the "Change" column for the following worksheets:
- General
- Sheet 1
- Sheet 2
- Sheet 3
- Sheet 4
- The user wants to do this whenever they wish about ensuring that the copy of the row(s) in the "Change Tracker 2" sheet matches the data from the sheet it is copied from. (Hence why my previous solution didn't really work as the practicalities of initiating the copy by putting "Y" in the "Change" column means it is too easy to update the other columns in the row after the fact and the copied version of the row will be out of date)

- The user does not want to delete the source data. It should remain in place.
- When the user initiates the copy it should populate the "Change Tracker sheet" with the source data as specified above, including all the columns in the row and add them without spaces between them.
- When a user has previously initiated a copy and chooses to do so again it should not add the new data to the bottom of the existing list on the "Change Tracker 2" sheet but replace this data. E.g. it is a capture of all the rows marked as change across all the rows at the time of initiating the copy from the above defined sheets only.

(please note there a "Version" change control sheet before the "General" Sheet that can be ignored.

My thought are a command button would be the best way to achieve the above but am open to suggestions. This could go on the "Change tracker 2" sheet which would make sense if going this way.

General Sheet (to copy from based on the above mentioned rules)

Configuration Summary Document v2.2.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

2

3

4

Date:

n/a

5

6

Seq

Change?

Change type

Date Raised

Raised by

Area

Issue

Action Required

Action Owner

Due Date

Status

Outcome

Notes (Please include name & date.

7

CONF-0001

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

15/04/2023

Me

Test General 1

End of row test 1

8

CONF-0002

N

Do not Copy this data to "Change Tracker 2" sheet.

16/04/2023

Myself

Test General 2

End of row test 2

9

CONF-0003

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

17/04/2023

Irene

Test General 3

End of row test 3

10

CONF-0004

N

Do not Copy this data to "Change Tracker 2" sheet.

18/04/2023

Me

Test General 4

End of row test 4

11

CONF-0005

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

19/04/2023

Myself

Test General 5

End of row test 5

12

CONF-0006

N

Do not Copy this data to "Change Tracker 2" sheet.

20/04/2023

Irene

Test General 6

End of row test 6

13

CONF-0007

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

21/04/2023

Me

Test General 7

End of row test 7

14

CONF-0008

N

Do not Copy this data to "Change Tracker 2" sheet.

22/04/2023

Myself

Test General 8

End of row test 8

15

CONF-0009

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

23/04/2023

Irene

Test General 9

End of row test 9

16

CONF-0010

N

Do not Copy this data to "Change Tracker 2" sheet.

24/04/2023

Me

Test General 10

End of row test 10

17

CONF-0011

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

25/04/2023

Myself

Test General 11

End of row test 11

18

CONF-0012

N

Do not Copy this data to "Change Tracker 2" sheet.

26/04/2023

Irene

Test General 12

End of row test 12

19

CONF-0013

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

27/04/2023

Me

Test General 13

End of row test 13

20

CONF-0014

N

Do not Copy this data to "Change Tracker 2" sheet.

28/04/2023

Myself

Test General 14

End of row test 14

21

CONF-0015

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

29/04/2023

Irene

Test General 15

End of row test 15

22

CONF-0016

23

CONF-0017

24

CONF-0018

General

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B7:N106	Expression	=IF($L7="COMPLETE",TRUE,FALSE)	text	NO

Cells with Data Validation
Cell	Allow	Criteria
L7:L24	List	=Status
I7:I24	List	=Action_Required
F7:F106	Any value
G7:G106	List	=Nimbus_Area

Sheet 1 (to copy from based on the above mentioned rules)

Configuration Summary Document v2.2.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

2

3

4

Date:

n/a

5

6

Seq

Change?

Change type

Date Raised

Raised by

NIMBUS Area

Issue

Action Required

Action Owner

Due Date

Status

Outcome

Notes (Please include name & date.

7

WS-PH-0001

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

15/04/2023

Me

Test Sheet 1 - 1

End of row test 1

8

WS-PH-0002

N

Do not Copy this data to "Change Tracker 2" sheet.

16/04/2023

Myself

Test Sheet 1 - 2

End of row test 2

9

WS-PH-0003

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

17/04/2023

Irene

Test Sheet 1 - 3

End of row test 3

10

WS-PH-0004

N

Do not Copy this data to "Change Tracker 2" sheet.

18/04/2023

Me

Test Sheet 1 - 4

End of row test 4

11

WS-PH-0005

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

19/04/2023

Myself

Test Sheet 1 - 5

End of row test 5

12

WS-PH-0006

N

Do not Copy this data to "Change Tracker 2" sheet.

20/04/2023

Irene

Test Sheet 1 - 6

End of row test 6

13

WS-PH-0007

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

21/04/2023

Me

Test Sheet 1 - 7

End of row test 7

14

WS-PH-0008

N

Do not Copy this data to "Change Tracker 2" sheet.

22/04/2023

Myself

Test Sheet 1 - 8

End of row test 8

15

WS-PH-0009

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

23/04/2023

Irene

Test Sheet 1 - 9

End of row test 9

16

WS-PH-0010

N

Do not Copy this data to "Change Tracker 2" sheet.

24/04/2023

Me

Test Sheet 1 - 10

End of row test 10

17

WS-PH-0011

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

25/04/2023

Myself

Test Sheet 1 - 11

End of row test 11

18

WS-PH-0012

N

Do not Copy this data to "Change Tracker 2" sheet.

26/04/2023

Irene

Test Sheet 1 - 12

End of row test 12

19

WS-PH-0013

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

27/04/2023

Me

Test Sheet 1 - 13

End of row test 13

20

WS-PH-0014

N

Do not Copy this data to "Change Tracker 2" sheet.

28/04/2023

Myself

Test Sheet 1 - 14

End of row test 14

21

WS-PH-0015

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

29/04/2023

Irene

Test Sheet 1 - 15

End of row test 15

22

WS-PH-0016

23

WS-PH-0017

24

WS-PH-0018

25

WS-PH-0019

Sheet 1

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E7:N21	Expression	=IF($L7="COMPLETE",TRUE,FALSE)	text	NO
C7:D106	Expression	=IF($K7="COMPLETE",TRUE,FALSE)	text	NO
B7:B106,E22:N106	Expression	=IF($L7="COMPLETE",TRUE,FALSE)	text	NO

Cells with Data Validation
Cell	Allow	Criteria
L7:L25	List	=Status
I7:I25	List	=Action_Required
F7:F106	Any value
G7:G106	List	=Nimbus_Area

Sheet 2 (to copy from based on the above mentioned rules)

Configuration Summary Document v2.2.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

2

3

4

Date:

28th March 2023

5

6

Seq

Change?

Change type

Date Raised

Raised by

NIMBUS Area

Issue

Action Required

Action Owner

Due Date

Status

Outcome

Notes (Please include name & date.

7

WS-CSE-0001

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

15/04/2023

Me

Test Sheet 2 - 1

End of row test 1

8

WS-CSE-0002

N

Do not Copy this data to "Change Tracker 2" sheet.

16/04/2023

Myself

Test Sheet 2 - 2

End of row test 2

9

WS-CSE-0003

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

17/04/2023

Irene

Test Sheet 2 - 3

End of row test 3

10

WS-CSE-0004

N

Do not Copy this data to "Change Tracker 2" sheet.

18/04/2023

Me

Test Sheet 2 - 4

End of row test 4

11

WS-CSE-0005

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

19/04/2023

Myself

Test Sheet 2 - 5

End of row test 5

12

WS-CSE-0006

N

Do not Copy this data to "Change Tracker 2" sheet.

20/04/2023

Irene

Test Sheet 2 - 6

End of row test 6

13

WS-CSE-0007

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

21/04/2023

Me

Test Sheet 2 - 7

End of row test 7

14

WS-CSE-0008

N

Do not Copy this data to "Change Tracker 2" sheet.

22/04/2023

Myself

Test Sheet 2 - 8

End of row test 8

15

WS-CSE-0009

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

23/04/2023

Irene

Test Sheet 2 - 9

End of row test 9

16

WS-CSE-0010

N

Do not Copy this data to "Change Tracker 2" sheet.

24/04/2023

Me

Test Sheet 2 - 10

End of row test 10

17

WS-CSE-0011

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

25/04/2023

Myself

Test Sheet 2 - 11

End of row test 11

18

WS-CSE-0012

N

Do not Copy this data to "Change Tracker 2" sheet.

26/04/2023

Irene

Test Sheet 2 - 12

End of row test 12

19

WS-CSE-0013

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

27/04/2023

Me

Test Sheet 2 - 13

End of row test 13

20

WS-CSE-0014

N

Do not Copy this data to "Change Tracker 2" sheet.

28/04/2023

Myself

Test Sheet 2 - 14

End of row test 14

21

WS-CSE-0015

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

29/04/2023

Irene

Test Sheet 2 - 15

End of row test 15

22

WS-CSE-0016

23

WS-CSE-0017

24

WS-CSE-0018

Sheet 2

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E7:N21	Expression	=IF($L7="COMPLETE",TRUE,FALSE)	text	NO
C7:D106	Expression	=IF($K7="COMPLETE",TRUE,FALSE)	text	NO
G53,I46:N74,B7:B106,E22:N45,E54:G74,E75:N106,E53,E46:G52	Expression	=IF($L7="COMPLETE",TRUE,FALSE)	text	NO

Cells with Data Validation
Cell	Allow	Criteria
I7:I24	List	=Action_Required
L7:L24	List	=Status
F7:F43	Any value
G7:G106	List	=Nimbus_Area

Sheet 3 (to copy from based on the above mentioned rules)

Configuration Summary Document v2.2.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

2

3

4

Date:

4th April 2023

5

6

Seq

Change?

Change type

Date Raised

Raised by

NIMBUS Area

Issue

Action Required

Action Owner

Due Date

Status

Outcome

Notes (Please include name & date.

7

WS-FOS-0001

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

15/04/2023

Me

Test Sheet 3 - 1

End of row test 1

8

WS-FOS-0002

N

Do not Copy this data to "Change Tracker 2" sheet.

16/04/2023

Myself

Test Sheet 3 - 2

End of row test 2

9

WS-FOS-0003

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

17/04/2023

Irene

Test Sheet 3 - 3

End of row test 3

10

WS-FOS-0004

N

Do not Copy this data to "Change Tracker 2" sheet.

18/04/2023

Me

Test Sheet 3 - 4

End of row test 4

11

WS-FOS-0005

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

19/04/2023

Myself

Test Sheet 3 - 5

End of row test 5

12

WS-FOS-0006

N

Do not Copy this data to "Change Tracker 2" sheet.

20/04/2023

Irene

Test Sheet 3 - 6

End of row test 6

13

WS-FOS-0007

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

21/04/2023

Me

Test Sheet 3 - 7

End of row test 7

14

WS-FOS-0008

N

Do not Copy this data to "Change Tracker 2" sheet.

22/04/2023

Myself

Test Sheet 3 - 8

End of row test 8

15

WS-FOS-0009

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

23/04/2023

Irene

Test Sheet 3 - 9

End of row test 9

16

WS-FOS-0010

N

Do not Copy this data to "Change Tracker 2" sheet.

24/04/2023

Me

Test Sheet 3 - 10

End of row test 10

17

WS-FOS-0011

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

25/04/2023

Myself

Test Sheet 3 - 11

End of row test 11

18

WS-FOS-0012

N

Do not Copy this data to "Change Tracker 2" sheet.

26/04/2023

Irene

Test Sheet 3 - 12

End of row test 12

19

WS-FOS-0013

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

27/04/2023

Me

Test Sheet 3 - 13

End of row test 13

20

WS-FOS-0014

N

Do not Copy this data to "Change Tracker 2" sheet.

28/04/2023

Myself

Test Sheet 3 - 14

End of row test 14

21

WS-FOS-0015

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

29/04/2023

Irene

Test Sheet 3 - 15

End of row test 15

22

WS-FOS-0016

23

WS-FOS-0017

24

WS-FOS-0018

25

WS-FOS-0019

Sheet 3

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E7:N21	Expression	=IF($L7="COMPLETE",TRUE,FALSE)	text	NO
C7:D106	Expression	=IF($K7="COMPLETE",TRUE,FALSE)	text	NO
M36:N42,I36:J36,I37:I41,L36:L41,B7:B106,E22:N35,E36:F42,E43:N106	Expression	=IF($L7="COMPLETE",TRUE,FALSE)	text	NO

Cells with Data Validation
Cell	Allow	Criteria
L7:L25	List	=Status
I7:I21	List	=Action_Required
F7:F21	Any value
G7:G21	List	=Nimbus_Area

Sheet 4 (to copy from based on the above mentioned rules)

Configuration Summary Document v2.2.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

2

3

4

Date:

11th April 2023

5

6

Seq

Change?

Change type

Date Raised

Raised by

NIMBUS Area

Issue

Action Required

Action Owner

Due Date

Status

Outcome

Notes (Please include name & date.

7

WS-VII-0001

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

15/04/2023

Me

Test Sheet 4 - 1

End of row test 1

8

WS-VII-0002

N

Do not Copy this data to "Change Tracker 2" sheet.

16/04/2023

Myself

Test Sheet 4 - 2

End of row test 2

9

WS-VII-0003

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

17/04/2023

Irene

Test Sheet 4 - 3

End of row test 3

10

WS-VII-0004

N

Do not Copy this data to "Change Tracker 2" sheet.

18/04/2023

Me

Test Sheet 4 - 4

End of row test 4

11

WS-VII-0005

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

19/04/2023

Myself

Test Sheet 4 - 5

End of row test 5

12

WS-VII-0006

N

Do not Copy this data to "Change Tracker 2" sheet.

20/04/2023

Irene

Test Sheet 4 - 6

End of row test 6

13

WS-VII-0007

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

21/04/2023

Me

Test Sheet 4 - 7

End of row test 7

14

WS-VII-0008

N

Do not Copy this data to "Change Tracker 2" sheet.

22/04/2023

Myself

Test Sheet 4 - 8

End of row test 8

15

WS-VII-0009

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

23/04/2023

Irene

Test Sheet 4 - 9

End of row test 9

16

WS-VII-0010

N

Do not Copy this data to "Change Tracker 2" sheet.

24/04/2023

Me

Test Sheet 4 - 10

End of row test 10

17

WS-VII-0011

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

25/04/2023

Myself

Test Sheet 4 - 11

End of row test 11

18

WS-VII-0012

N

Do not Copy this data to "Change Tracker 2" sheet.

26/04/2023

Irene

Test Sheet 4 - 12

End of row test 12

19

WS-VII-0013

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

27/04/2023

Me

Test Sheet 4 - 13

End of row test 13

20

WS-VII-0014

N

Do not Copy this data to "Change Tracker 2" sheet.

28/04/2023

Myself

Test Sheet 4 - 14

End of row test 14

21

WS-VII-0015

Y

Copy this data to "Change Tracker 2" sheet. Do not delete after transfer

29/04/2023

Irene

Test Sheet 4 - 15

End of row test 15

22

WS-VII-0016

23

WS-VII-0017

24

WS-VII-0018

Sheet 4

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
E7:N21	Expression	=IF($L7="COMPLETE",TRUE,FALSE)	text	NO
C7:D106	Expression	=IF($K7="COMPLETE",TRUE,FALSE)	text	NO
B7:B106,E22:N106	Expression	=IF($L7="COMPLETE",TRUE,FALSE)	text	NO

Cells with Data Validation
Cell	Allow	Criteria
F7:F106	Any value
G7:G106	List	=Nimbus_Area
I7:I24	List	=Action_Required
L7:L24	List	=Status

Change Tracker 2 (to copy to based on the above mentioned rules so would end up with all the rows marked as "Y" in the "Change?" column for the above sheets)

Configuration Summary Document v2.2.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

1

2

3

4

Date:

11th April 2023

5

6

Seq

Change?

Change type

Date Raised

Raised by

NIMBUS Area

Issue

Action Required

Action Owner

Due Date

Status

Outcome

Notes (Please include name & date.

7

8

9

10

11

12

13

14

15

16

17

18

19

20

Change Tracker 2

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B7:N7	Expression	=IF($L7="COMPLETE",TRUE,FALSE)	text	NO
B8:N8	Expression	=IF($L8="COMPLETE",TRUE,FALSE)	text	NO
B9:N9	Expression	=IF($L9="COMPLETE",TRUE,FALSE)	text	NO
B12:N12	Expression	=IF($L12="COMPLETE",TRUE,FALSE)	text	NO
B11:N11	Expression	=IF($L11="COMPLETE",TRUE,FALSE)	text	NO
B10:N10	Expression	=IF($L10="COMPLETE",TRUE,FALSE)	text	NO

Cells with Data Validation
Cell	Allow	Criteria
F7:F12	Any value
G7:G12	List	=Nimbus_Area
I7:I12	List	=Action_Required
L7:L12	List	=Status

kevin9999 · Apr 16, 2023

Thank you for the very detailed response - it makes life so much easier

Please try the following on a copy of your file. I'd be surprised if it works perfectly first time, but it's a start.

VBA Code:

Option Explicit
Sub Change_Tracker()
    On Error GoTo Escape
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim ws As Worksheet, ws1 As Worksheet
    Set ws1 = Worksheets("Change Tracker 2")
    
    Dim SheetList, i As Long, LRow As Long
    SheetList = Array("General", "Sheet 1", "Sheet 2", "Sheet 3", "Sheet 4")
    
    For i = LBound(SheetList) To UBound(SheetList)
        With Worksheets(SheetList(i)).Range("B6:N6")
            .AutoFilter 2, "Y"
            LRow = ws1.Cells(Rows.Count, 2).End(xlUp).Row + 1
            .CurrentRegion.Offset(1).Copy ws1.Cells(LRow, 2)
            .AutoFilter
        End With
    Next i
    With ws1.Range("B6:N" & Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row)
        .RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13), Header:=xlYes
    End With
    
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

Uhtred Bebbanburg · Apr 16, 2023

kevin9999 said:

Thank you for the very detailed response - it makes life so much easier

Please try the following on a copy of your file. I'd be surprised if it works perfectly first time, but it's a start.

VBA Code:

Option Explicit
Sub Change_Tracker()
    On Error GoTo Escape
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim ws As Worksheet, ws1 As Worksheet
    Set ws1 = Worksheets("Change Tracker 2")
   
    Dim SheetList, i As Long, LRow As Long
    SheetList = Array("General", "Sheet 1", "Sheet 2", "Sheet 3", "Sheet 4")
   
    For i = LBound(SheetList) To UBound(SheetList)
        With Worksheets(SheetList(i)).Range("B6:N6")
            .AutoFilter 2, "Y"
            LRow = ws1.Cells(Rows.Count, 2).End(xlUp).Row + 1
            .CurrentRegion.Offset(1).Copy ws1.Cells(LRow, 2)
            .AutoFilter
        End With
    Next i
    With ws1.Range("B6:N" & Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row)
        .RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13), Header:=xlYes
    End With
   
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub

You sir are a genius. This worked straight away just had to assign it to the button. Only thing I added was to clear the "Change Tracker 2" worksheet at the start of the routine.

No need to thank me for the detailed response least I can do when you're helping me out. I really appreciate it so much.

I'm a business analyst so used to writing detailed requirements for developers and architects. Dabbled a little in coding myself when I was a systems implementation consultant but was never my forte. Was always better on the business side.

If you ever need help writing functional/non func/system requirements etc. give me a shout so I can return the favour.

Thanks again

Dan

kevin9999 · Apr 16, 2023

Hi Dan, glad it worked out first time and thanks for the kind feedback

. Welcome to MrExcel!

Copying entire row from multiple worksheets to one target worksheet using a command button

Uhtred Bebbanburg

New Member

Excel Facts

kevin9999

Well-known Member

Uhtred Bebbanburg

New Member

kevin9999

Well-known Member

Uhtred Bebbanburg

New Member

kevin9999

Well-known Member

Similar threads

Forum statistics

Share this page

Copying entire row from multiple worksheets to one target worksheet using a command button

Uhtred Bebbanburg

New Member

Excel Facts

kevin9999

Well-known Member

Uhtred Bebbanburg

New Member

kevin9999

Well-known Member

Uhtred Bebbanburg

New Member

kevin9999

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock