How to copy data from certain columns in a row from one sheet to another
Category: [Excel] Demo Available
How to copy data from certain columns in a row from one sheet to another
Requirement:
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):
Code:
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?
Solution:
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:-
Code:
Sub Test()
Dim ws As Worksheet, sh As Worksheet
Set sh = Sheets("Report")
Application.ScreenUpdating = False
sh.UsedRange.Offset(1).Clear
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
.AutoFilter
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.