VBA script to copy specific rows based on column contents

plaasma30

New Member
Joined
Mar 13, 2021
Messages
6
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
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
ABCDEFGHIJKLMNOPQRST
9data1data2data3data4data5data6data7data8data9data10data11data12data13data14data15data16data17data18data19data20
10
11gjdlkgd1dgdgd3434sdfdsf5454fsdf464565445679981009126546488884564fgfddfgdf5fdg3434fg
12dfglkdfgdgdfg435sfds454dsfds6544654348895308546889544dfgdfgdf45fdg34345dfg
13dfglkdfg2dfgkldf434fds454sdfsd545469107600548885654dfgdfgdf45fdg3453dfg
14dfglkfddfgdd343sdfdsf454sdfds4555464017100154797564dfgdfgdf45dfg3453dfg
15fdlgnkdkfldfgdf343sdfdsf456fsdfsdf54456401975104567995654dfgdfgdf3fdg34543dfg
16dfklgndkfdfgdfg53sdfsd45664sdf45456390950145645717456dfgdfg2fgdf3453dfg
Sheet1
Cell Formulas
RangeFormula
J11:J16J11=N11+S11
K11:K16K11=H11+I11
M11:M16M11=D11+F11


contents of Sheet2:
sample_sheet.xlsx
ABCDEFGHIJKLMNOPQRST
8data1data2data3data4data5data6data7data8data9data10data11data12data13data14data15data16data17data18data19data20
9
10gjdlkgddgdgd3434sdfdsf5454fsdf464565445679981009126546488884564fgfddfgdf5fdg3434fg
11dfglkdfg3dgdfg435sfds454dsfds6544654348895308546889544dfgdfgdf45fdg34345dfg
12dfglkdfgdfgkldf434fds454sdfsd545469107600548885654dfgdfgdf45fdg3453dfg
13dfglkfddfgdd343sdfdsf454sdfds4555464017100154797564dfgdfgdf45dfg3453dfg
14fdlgnkdkfldfgdf343sdfdsf456fsdfsdf54456401975104567995654dfgdfgdf3fdg34543dfg
15dfklgndkf5dfgdfg53sdfsd45664sdf45456390950145645717456dfgdfg2fgdf3453dfg
Sheet2
Cell Formulas
RangeFormula
J10:J15J10=N10+S10
K10:K15K10=H10+I10
M10:M15M10=D10+F10


contents of Sheet3:
sample_sheet.xlsx
ABCDEFGHIJKLMNOPQRST
9data1data2data3data4data5data6data7data8data9data10data11data12data13data14data15data16data17data18data19data20
10
11gjdlkgd2dgdgd3434sdfdsf5454fsdf464565445679981009126546488884564fgfddfgdf5fdg3434fg
12dfglkdfgdgdfg435sfds454dsfds6544654348895308546889544dfgdfgdf45fdg34345dfg
13dfglkdfgdfgkldf434fds454sdfsd545469107600548885654dfgdfgdf45fdg3453dfg
14dfglkfddfgdd343sdfdsf454sdfds4555464017100154797564dfgdfgdf45dfg3453dfg
15fdlgnkdkfl4dfgdf343sdfdsf456fsdfsdf54456401975104567995654dfgdfgdf3fdg34543dfg
16dfklgndkfdfgdfg53sdfsd45664sdf45456390950145645717456dfgdfg2fgdf3453dfg
Sheet3
Cell Formulas
RangeFormula
J11:J16J11=N11+S11
K11:K16K11=H11+I11
M11:M16M11=D11+F11


contents of destination:
sample_sheet.xlsx
ABCDEF
5data1data2data4data10data11data13
destination


Thanks,
plasma30
 

kanadaaa

Active Member
Joined
Dec 29, 2019
Messages
348
Office Version
  1. 365
Platform
  1. Windows
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.
VBA Code:
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:
VBA Code:
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:
Rich (BB code):
lr = Sheets("destination").Cells(Rows.Count, "C").End(xlUp).Row + 2
Thus try the code below:
VBA Code:
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
 
Solution

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

plaasma30

New Member
Joined
Mar 13, 2021
Messages
6
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Your code worked great as usual. Thanks for all your help. I will mark this post as solved.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,045
Messages
5,639,746
Members
417,108
Latest member
Thein Than

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top