VBA Copying/Pasting problem when data is filtered

S

Sarah (OGI)

I've got 3 worksheets, one containing source data and two associated with
specific companies.

Firstly, I need to filter the source data worksheet to identify the required
company name. Once filtered, I then need to copy/paste certain columns into
the relevant worksheet.

The code below works fine; filtering column A of the source data worksheet
by the company name (ABC Ltd), and pasting it into the relevant section of
the ABC Ltd worksheet.

However, the code is only ok when the first filtered row is row 2. When
repeating the code for the next company/worksheet, the first filtered row
begins at row 3850, but this may change everytime the source data is updated.

Is there any way therefore, to avoid specifying a particular row number once
the data has been filtered? Or can I copy the cells from the required
columns where the value in column A matches a certain value/name?

Apologies if I've overcomplicated a simple issue. Many thanks!

Sheets("OCR").Select
ActiveSheet.ShowAllData
Selection.AutoFilter Field:=1, Criteria1:="ABC Ltd"
Range("O2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("ABC OCR").Select
Range("E2").Select
ActiveSheet.Paste
Range("F2").Select
Sheets("OCR").Select
Range("Q2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ABC OCR").Select
ActiveSheet.Paste
Range("G2").Select
Sheets("OCR").Select
Range("U2:W2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ABC OCR").Select
ActiveSheet.Paste
Range("J2").Select
Sheets("OCR").Select
Range("AD2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ABC OCR").Select
ActiveSheet.Paste
Range("D3").Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D2").Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.AutoFill Destination:=Range("A2:D" &
ActiveSheet.UsedRange.Rows.Count)
Range("E2").Select
 
J

joel

I don't know if last Row is the same for every column, if so you only need
one Last Row statement

With Sheets("OCR")
.ShowAllData
.AutoFilter Field:=1, Criteria1:="ABC Ltd"
LastRow = Range("O" & Rows.Count).End(xlUp).Row
.Range("O2:O" & LastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("ABC OCR").Range("E2")
LastRow = Range("Q" & Rows.Count).End(xlUp).Row
.Range("Q2:Q" & LastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("ABC OCR").Range("F2")
LastRow = Range("U" & Rows.Count).End(xlUp).Row
.Range("U2:W" & LastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("ABC OCR").Range("G2")
LastRow = Range("AD" & Rows.Count).End(xlUp).Row
.Range("AD2:AD" & LastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("ABC OCR").Range("J2")
End With

With Sheets("ABC OCR")

FirstCol = .Range("D2").End(xlToLeft).Column
LastRow = .Cells(2, FirstCol).End(xlDown).Row
.Range(.Cells(3, FirstrCol), .Cells(LastRow, "D")).ClearContents
.Range(.Cells(2, FirstCol), .Range("D2")).Copy _
Destination:=.Range(.Cells(3, FirstrCol), .Cells(LastRow, "D"))
End With
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top