How to copy rows to another worksheet based on criteria satisfaction using VBA

[alisun125]

Hello,

I am having problems writing a code to copy the rows from one worksheet to another, if certain criteria are met.

A data dump is taken from a report and copied into worksheet "a" (starting at C5 due to column headings etc), then in worksheet "b" I need to, on the pressing of a command button, delete the current data in worksheet "b" (C5:Z21000), and pull through data from worksheet "a" (C5:Z21000) if the code number in Column P ends with a ".99" (example code: AB.CD.01.99) and if Column S is NOT populated.

The reason for the deleting of data first is that the only the current/live ".99" rows need to be copied through, and if Column S is populated or the code number has changed, then the actions against the rows have been completed.

It is not essential, but would be super helpful if the code could only bring through Columns CDEFGHIPQRST and put them in CDEFGHIJKLMN.

Many thanks in advance.

alisun125



Post moved by Mod

 

[capsal]

Hi,

Maybe this is of help

Sub alisun125()

Dim wsa As Worksheet, wsb As Worksheet
Dim rga As Range
Dim hcol As Range

Dim lastr_a As Long, lastc_a As Long
Dim col_end_with As String

With ThisWorkbook
Set wsa = .Worksheets(1) 'change accordingly using quotes for worksheet name
Set wsb = .Worksheets(2) 'change...
End With

lastr_a = 5 'row 5
lastc_a = 26 'col Z

With wsa
  .Activate
  Set rga = .Range(.Cells(5, 3), .Cells(21000, 26))
  Set hcol = rga.Resize(, 1).Offset(, rga.Columns.Count)

  With hcol
  .Formula = "=IF(RIGHT(P5,2)=""99"",1,0)" 'helper column 27 formula
  .Offset(, 1).Formula = "=IF(S5<>"""",0,1)" 'helper column 28 formula
  .Offset(, 2).Formula = "=IF(AND(AA5=1,AB5=1),1,0)" 'helper  column 29 formula
  End With

  Set hcol = rga.Offset(-1, 0).Resize(, rga.Columns.Count + 3)
  hcol.AutoFilter field:=27, Criteria1:=1 ' filter on helper column 29 value

  .Range(.Columns(10), .Columns(15)).EntireColumn.Hidden = True
  .Range(.Columns(21), .Columns(29)).EntireColumn.Hidden = True

  Set hcol = hcol.Offset(1, 0)
  hcol.SpecialCells(xlCellTypeVisible).Copy wsb.Range("C5")

  .Range(.Columns(10), .Columns(15)).EntireColumn.Hidden = False
  .Range(.Columns(21), .Columns(29)).EntireColumn.Hidden = False

  hcol.AutoFilter 'turn autofilter off
  Set hcol = hcol.Offset(, hcol.Columns.Count - 3).Resize(, 3)
  hcol.ClearContents 'clear helper formula

End With

End Sub