How to copy data from certain columns in a row from one sheet to another

< Back to Search results

 Category: [Excel]  Demo Available 

How to copy data from certain columns in a row from one sheet to another




The user has an excel file with six worksheets, each one dedicated to different projects and their status.


Added another workship ("Report") for reporting purposes, and the user wants to populate it with all the rows that have a YES in column O, so I have used the VBA formula below (taken for another thread in this forum):

Option Explicit
Sub Received()
Dim ws As Worksheet
Dim i As Long, lr As Long, lastrow As Long
lastrow = Sheets("Report").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Report").Range("A2:A" & lastrow).EntireRow.ClearContents
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> "Report" Then
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lr
lastrow = Sheets("Report").Range("A" & Rows.Count).End(xlUp).Row + 1
If ws.Range("O" & i) = "YES" Then
ws.Range("O" & i).EntireRow.Copy Sheets("Report").Range("A" & lastrow)
End If
Next i
End If
Next ws
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

The problem is that the user doen't need the entire row, but the data of the columns B, C, J, K and L. How can the user modify the code so only that information is shown in the reporting sheet? 






You placed the code in the "Report" sheet module. This code needs to be placed in a standard module as it is not an event code.


The CurrentRegion (the data set) starts at A4 not A1.

- You have an additional sheet "Other data", previously unmentioned, which the code was attempting to extract data from.
- One sheet had filters turned on already.

So, to tidy things up for you, here is the code again:-

Sub Test()

        Dim ws As Worksheet, sh As Worksheet
        Set sh = Sheets("Report")

Application.ScreenUpdating = False

For Each ws In Worksheets
        ws.AutoFilterMode = False
        If ws.Name <> "Report" And ws.Name <> "Other data" Then
With ws.[A4].CurrentRegion
        .AutoFilter 15, "YES"
        Union(.Columns("B:C"), .Columns("J:L")).Offset(1).Copy
        sh.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
        End With
    End If
Next ws

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

I've added an additional line (in blue font) which ensures that all filters are turned off prior to the code running.
I've added the "Other data" sheet (in red font) to be excluded from the whole process.


Obtained from the OzGrid Help Forum.

Solution provided by Carim.


See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets


See also:

How to auto copy data from master list to sub worksheets based on data value in one column
How to use VBA code to transpose any copy values X number of times
How to copy the data from sheet 1 and paste the data to sheet 2 each first empty row of each row
How to copy from cell into next empty cell and loop through


Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.


stars (0 Reviews)