VBA script to copy specific rows based on column contents

[plaasma30]

Hello fellow excel users,

I have 5 spreadsheets each with 48 columns. Based on the values entered in 'column B' I would like to copy those particular rows but not all the columns to a separate 'destination' sheet. Also, checking across the rest of the spreadsheets. Please see below to the corresponding mini-sheet versions for your reference. There are three different sheets, namely Sheet1, Sheet2 and Sheet 3 each with 20 columns. The values are entered in column B of every sheet. Some values in some of the columns (such as columns J, K and M) rely on the values from other columns. I have highlighted the normal columns (in yellow), the columns with formula (in green) and rows (in red). The ones highlighted in red are the ones to be copied to their corresponding columns (marked as bold) that are found in the destination sheet . I am not sure how to handle the cells with formula while copying them to the destination sheet. Any help would be kindly appreciated.

contents of Sheet1:

sample_sheet.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
9	data1	data2	data3	data4	data5	data6	data7	data8	data9	data10	data11	data12	data13	data14	data15	data16	data17	data18	data19	data20
10
11	gjdlkgd	1	dgdgd	3434	sdfdsf	5454	fsdf	46456	54456	7998	100912	65464	8888	4564	fgfd	dfgdf	5	fdg	3434	fg
12	dfglkdfg		dgdfg	435	sfds	454	dsfds	654	4654	34889	5308	546	889	544	dfg	dfgdf	45	fdg	34345	dfg
13	dfglkdfg	2	dfgkldf	434	fds	454	sdfsd	54	546	9107	600	54	888	5654	dfg	dfgdf	45	fdg	3453	dfg
14	dfglkfd		dfgdd	343	sdfdsf	454	sdfds	455	546	4017	1001	54	797	564	dfg	dfgdf	45	dfg	3453	dfg
15	fdlgnkdkfl		dfgdf	343	sdfdsf	456	fsdfsdf	54	456	40197	510	456	799	5654	dfg	dfgdf	3	fdg	34543	dfg
16	dfklgndkf		dfgdfg	53	sdfsd	45664	sdf	45	456	3909	501	456	45717	456	dfg	dfg	2	fgdf	3453	dfg
Sheet1

Cell Formulas
Range	Formula
J11:J16	J11	=N11+S11
K11:K16	K11	=H11+I11
M11:M16	M11	=D11+F11

contents of Sheet2:

sample_sheet.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
8	data1	data2	data3	data4	data5	data6	data7	data8	data9	data10	data11	data12	data13	data14	data15	data16	data17	data18	data19	data20
9
10	gjdlkgd		dgdgd	3434	sdfdsf	5454	fsdf	46456	54456	7998	100912	65464	8888	4564	fgfd	dfgdf	5	fdg	3434	fg
11	dfglkdfg	3	dgdfg	435	sfds	454	dsfds	654	4654	34889	5308	546	889	544	dfg	dfgdf	45	fdg	34345	dfg
12	dfglkdfg		dfgkldf	434	fds	454	sdfsd	54	546	9107	600	54	888	5654	dfg	dfgdf	45	fdg	3453	dfg
13	dfglkfd		dfgdd	343	sdfdsf	454	sdfds	455	546	4017	1001	54	797	564	dfg	dfgdf	45	dfg	3453	dfg
14	fdlgnkdkfl		dfgdf	343	sdfdsf	456	fsdfsdf	54	456	40197	510	456	799	5654	dfg	dfgdf	3	fdg	34543	dfg
15	dfklgndkf	5	dfgdfg	53	sdfsd	45664	sdf	45	456	3909	501	456	45717	456	dfg	dfg	2	fgdf	3453	dfg
Sheet2

Cell Formulas
Range	Formula
J10:J15	J10	=N10+S10
K10:K15	K10	=H10+I10
M10:M15	M10	=D10+F10

contents of Sheet3:

sample_sheet.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T
9	data1	data2	data3	data4	data5	data6	data7	data8	data9	data10	data11	data12	data13	data14	data15	data16	data17	data18	data19	data20
10
11	gjdlkgd	2	dgdgd	3434	sdfdsf	5454	fsdf	46456	54456	7998	100912	65464	8888	4564	fgfd	dfgdf	5	fdg	3434	fg
12	dfglkdfg		dgdfg	435	sfds	454	dsfds	654	4654	34889	5308	546	889	544	dfg	dfgdf	45	fdg	34345	dfg
13	dfglkdfg		dfgkldf	434	fds	454	sdfsd	54	546	9107	600	54	888	5654	dfg	dfgdf	45	fdg	3453	dfg
14	dfglkfd		dfgdd	343	sdfdsf	454	sdfds	455	546	4017	1001	54	797	564	dfg	dfgdf	45	dfg	3453	dfg
15	fdlgnkdkfl	4	dfgdf	343	sdfdsf	456	fsdfsdf	54	456	40197	510	456	799	5654	dfg	dfgdf	3	fdg	34543	dfg
16	dfklgndkf		dfgdfg	53	sdfsd	45664	sdf	45	456	3909	501	456	45717	456	dfg	dfg	2	fgdf	3453	dfg
Sheet3

Cell Formulas
Range	Formula
J11:J16	J11	=N11+S11
K11:K16	K11	=H11+I11
M11:M16	M11	=D11+F11

contents of destination:

sample_sheet.xlsx
	A	B	C	D	E	F
5	data1	data2	data4	data10	data11	data13
destination

Thanks,
plasma30

 

[kanadaaa]

Hi and welcome to the board.
One question for information that's needed to write a code:
What's the name of the sheet that's not mentioned out of the 5 sheets?

 

[plaasma30]

Hi thank you for your kind reply .
The sample file that I supplied is for illustrative purpose only. The original file contains 5 sheets which I can't share for privacy reasons.
The sample file only contains four sheets, namely Sheet 1, Sheet 2, Sheet 3 and destination.
Sheets 1-3 contain the specific rows (highlighted in red) that I would like to copy to the sheet titled "destination", please.
I will then apply the code from here to the original file accordingly.
Please do let me know if I missed something.
Thanks,
Plasma30

 

[kanadaaa]

Try this in a standard module:

Sub OutputValueToSheetDestination()
    Dim heading As Range, data2 As Range, data2Temp As Range, lr As Long
    
    Application.ScreenUpdating = False
    For Each Sheet In Sheets
        With Sheet
            If .Name <> "destination" Then 'If you have other sheets irrelevant to data ouput, their names need to be specified here
                Set heading = .Range("B:B").Find("data2")
                Set data2 = .Range("B:B").Find("*", .Range(heading.Address(0, 0)))
                Set data2Temp = data2
                Do While Not data2 Is Nothing
                    If data2.Row <= heading.Row Then Exit Do
                    lr = Sheets("destination").Cells(Rows.Count, "A").End(xlUp).Row + 1
                    Sheets("destination").Cells(lr, "A").Value = .Cells(data2.Row, "A").Value
                    Sheets("destination").Cells(lr, "B").Value = .Cells(data2.Row, "B").Value
                    Sheets("destination").Cells(lr, "C").Value = .Cells(data2.Row, "D").Value
                    Sheets("destination").Cells(lr, "D").Value = "=" & .Name & "!" & .Cells(data2.Row, "J").Address
                    Sheets("destination").Cells(lr, "E").Value = "=" & .Name & "!" & .Cells(data2.Row, "K").Address
                    Sheets("destination").Cells(lr, "F").Value = "=" & .Name & "!" & .Cells(data2.Row, "M").Address
                    Set data2 = .Range("B:B").FindNext(data2)
                    If data2.Address = data2Temp.Address Then Exit Do
                Loop
            End If
        End With
    Next Sheet
    Application.ScreenUpdating = True
    
End Sub

 

[plaasma30]

This works great!! Thank you.
I get you question now. I have 5 sheets in the original file out of 50 sheets that are named differently but I can add a matching initial say 'W_' to recognize the 5 sheets in question. But how can proceed. I can use the following piece of code before `With Sheet` loop but I am getting an error:
`If Left$(Sheet.Name, 2) = "W_" Then`

 

[kanadaaa]

Glad it worked and thanks for feedback.

I am getting an error

Replace the line with my comment with:

If Left(.Name, 2) = "W_" Then

(You just have the redundant "$".)

 

[kanadaaa]

And I stuck to outputting formulas for data10, 11, and 13 but actually the following code does fundamentally the same trick:

Sub OutputValueToSheetDestination()
    Dim heading As Range, data2 As Range, data2Temp As Range, lr As Long
    
    Application.ScreenUpdating = False
    For Each Sheet In Sheets
        With Sheet
            'If .Name <> "destination" Then
            If Left(.Name, 2) = "W_" Then 'Sheets' names for data ouput need to be specified here
                Set heading = .Range("B:B").Find("data2")
                Set data2 = .Range("B:B").Find("*", .Range(heading.Address(0, 0)))
                Set data2Temp = data2
                Do While Not data2 Is Nothing
                    If data2.Row <= heading.Row Then Exit Do
                    lr = Sheets("destination").Cells(Rows.Count, "A").End(xlUp).Row + 1
                    Sheets("destination").Cells(lr, "A").Value = .Cells(data2.Row, "A").Value
                    Sheets("destination").Cells(lr, "B").Value = .Cells(data2.Row, "B").Value
                    Sheets("destination").Cells(lr, "C").Value = .Cells(data2.Row, "D").Value
                    Sheets("destination").Cells(lr, "D").Value = .Cells(data2.Row, "J").Value 'Changed
                    Sheets("destination").Cells(lr, "E").Value = .Cells(data2.Row, "K").Value 'Changed
                    Sheets("destination").Cells(lr, "F").Value = .Cells(data2.Row, "M").Value 'Changed
                    Set data2 = .Range("B:B").FindNext(data2)
                    If data2.Address = data2Temp.Address Then Exit Do
                Loop
            End If
        End With
    Next Sheet
    Application.ScreenUpdating = True
    
End Sub

The code in #4 outputs formulas like so:

1164844 Copy specific values to another ws.xlsm
	A	B	C	D	E	F
1	data1	data2	data4	data10	data11	data13
2	gjdlkgd	1	3434	7998	100912	8888
destination

Cell Formulas
Range	Formula
D2	D2	=Sheet1!$J$11
E2	E2	=Sheet1!$K$11
F2	F2	=Sheet1!$M$11

But the one in this post doesn't (although both result in the same values)

1164844 Copy specific values to another ws.xlsm
	A	B	C	D	E	F
1	data1	data2	data4	data10	data11	data13
2	gjdlkgd	1	3434	7998	100912	8888
destination

 

[plaasma30]

Perfect and they both work great for me. Thank you.
I have two more questions, please
How can I get the output to start from cell C16?
How can I make the output from one of the columns with formula to exactly show as percentage value instead of showing in decimal?

 

[kanadaaa]

How can I get the output to start from cell C16?

Assuming you have headers like so:

1164844 Copy specific values to another ws.xlsm
	C	D	E	F	G	H
15	data1	data2	data4	data10	data11	data13
16
destination

Change these lines:

lr = Sheets("destination").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("destination").Cells(lr, "A").Value = .Cells(data2.Row, "A").Value
Sheets("destination").Cells(lr, "B").Value = .Cells(data2.Row, "B").Value
Sheets("destination").Cells(lr, "C").Value = .Cells(data2.Row, "D").Value
Sheets("destination").Cells(lr, "D").Value = .Cells(data2.Row, "J").Value
Sheets("destination").Cells(lr, "E").Value = .Cells(data2.Row, "K").Value
Sheets("destination").Cells(lr, "F").Value = .Cells(data2.Row, "M").Value

Like below (make sure that you save the workbook before running the macro):

Sub OutputValueToSheetDestination()
    Dim heading As Range, data2 As Range, lr As Long
   
    Application.ScreenUpdating = False
    For Each Sheet In Sheets
        With Sheet
            'If .Name <> "destination" Then
            If Left(.Name, 2) = "W_" Then 'Sheets' names for data ouput need to be specified here
                Set heading = .Range("B:B").Find("data2")
                Set data2 = .Range("B:B").Find("*", .Range(heading.Address(0, 0)))
                Do While Not data2 Is Nothing
                    If data2.Row <= heading.Row Then Exit Do
                    lr = Sheets("destination").Cells(Rows.Count, "C").End(xlUp).Row + 1 'Changed
                    Sheets("destination").Cells(lr, "C").Value = .Cells(data2.Row, "A").Value 'Changed
                    Sheets("destination").Cells(lr, "D").Value = .Cells(data2.Row, "B").Value 'Changed
                    Sheets("destination").Cells(lr, "E").Value = .Cells(data2.Row, "D").Value 'Changed
                    Sheets("destination").Cells(lr, "F").Value = .Cells(data2.Row, "J").Value 'Changed
                    Sheets("destination").Cells(lr, "G").Value = .Cells(data2.Row, "K").Value 'Changed
                    Sheets("destination").Cells(lr, "H").Value = .Cells(data2.Row, "M").Value 'Changed
                    Set data2 = .Range("B:B").FindNext(data2)
                Loop
            End If
        End With
    Next Sheet
    Application.ScreenUpdating = True
   
End Sub

Note:
If there are nonempty cells below C16, we'll need a little more modifications.

How can I make the output from one of the columns with formula to exactly show as percentage value instead of showing in decimal?

You don't need a code to achieve that (although you CAN achieve it with a code).

Result:

 

[plaasma30]

Thanks for your post. It's of great help!!
My headers are a bit different than the ones I posted in my sample file.
There are a few lines of info before the header then a gap of an entire row so that the output starts from C17 onwards. Hope this makes sense.