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]

You seem to understand the basics of VBA codes, so I'll explain how I find the last empty cell in column C in the code I posted in #9.

Dim lr as Long

I declared the variable "lr" which is the abbreviation for "last row" (the variable name can be anything).
The point is how I define this variable. Let's see:

lr = Sheets("destination").Cells(Rows.Count, "C").End(xlUp).Row + 1

1. Sheets("destination")
- This specifies a worksheet
2. Rows.Count
- This returns how many rows the sheet has, namely 10448576
3. Cells(Rows.Count, "C")
- So this returns cell C10448576
4. End(xlUp)
- This finds the cell that you reach when you press End then ↑ when you've selected the above cell (If the cells C16:C10448576 are all empty and C15 is filled, this returns the cell address C15).
5. Row
This returns the row number of the cell address you've got to. So in this case this returns 15.
6. +1
This just adds 1 to the row number found above. (So it returns 16.)

So the partial code above is one of the most common way to find the last empty cell in a column.
And you're needing to find the row number 17, so you'll just need to change the number of addition in step 6. So:

lr = Sheets("destination").Cells(Rows.Count, "C").End(xlUp).Row + 2

Thus try the code below:

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 + 2 'Changed
                    Sheets("destination").Cells(lr, "C").Value = .Cells(data2.Row, "A").Value
                    Sheets("destination").Cells(lr, "D").Value = .Cells(data2.Row, "B").Value
                    Sheets("destination").Cells(lr, "E").Value = .Cells(data2.Row, "D").Value
                    Sheets("destination").Cells(lr, "F").Value = .Cells(data2.Row, "J").Value
                    Sheets("destination").Cells(lr, "G").Value = .Cells(data2.Row, "K").Value
                    Sheets("destination").Cells(lr, "H").Value = .Cells(data2.Row, "M").Value
                    Set data2 = .Range("B:B").FindNext(data2)
                Loop
            End If
        End With
    Next Sheet
    Application.ScreenUpdating = True
   
End Sub

 

[plaasma30]

Your code worked great as usual. Thanks for all your help. I will mark this post as solved.