Copying meaningful data only into new worksheet - VBA

[Rachel Curran]

Hi,

I am trying to copy rows that only have meaningful data in them. I
want to do this in VBA.

For example I have the following data in Sheet2 (data derived from
vlookups and = formulas):

Emp No Name DOB Grade
12345 Rachel 28/02/78 A
45678 Debbie 15/09/82 A
54872 David 11/05/69 B
#N/A #N/A 0 0
#N/A #N/A 0 0

I only want to copy and paste the rows that have meaningful data - in
the above example this would be rows 1, 2 and 3. The amount of rows
will change each time the vba code is ran. So there could be more or
less rows each time.

How do I write in VBA a formula to say if cells have #N/A or 0 in them
do not copy these rows into a new worksheet, only copy meaningful
data.

Any help would be appreciated

Kind Regards

R Curran

 

[Don Guillett]

try data>autofilter>filter on the dob col for (custom) <>0>copy to cell
desired. Record a macro and then modify to suit. The last row in the
destination can be determined by
x=sheets("destinationsheet").cells(rows.count,"a").end(xlup).row +1

 

[Guest]

Option Explicit


Dim SrcSht As Worksheet, DEstSht As Worksheet
Dim SrcRange As Range, SrcRow As Range, SrcCell As Range
Dim DestRow As Single, ValidRow As Boolean


Sub CopyMeaningfulDAta()
With ThisWorkbook
Set SrcSht = .Sheets("Sheet1")
Set DEstSht = .Sheets("Sheet2")
End With
Set SrcRange = SrcSht.Cells(1, 2).CurrentRegion
If SrcRange.Rows.Count > 1 Then
DestRow = 0
For Each SrcRow In SrcRange.Rows
ValidRow = True
For Each SrcCell In SrcRow.Cells
If IsError(SrcCell) Then
ValidRow = False
Else
Select Case IsNumeric(SrcCell)
Case True
If SrcCell = 0 Then ValidRow =
False
Case False
If SrcCell = "" Or IsError
(SrcCell) Then
ValidRow = False
End If
End Select
End If
Next
If ValidRow Then
DestRow = DestRow + 1
For Each SrcCell In SrcRow.Cells
DEstSht.Cells(DestRow, SrcCell.Column)
= SrcCell
Next
End If
Next
End If

End Sub

 

[Hayes0]

Option Explicit


Dim SrcSht As Worksheet, DEstSht As Worksheet
Dim SrcRange As Range, SrcRow As Range, SrcCell As Range
Dim DestRow As Single, ValidRow As Boolean


Sub CopyMeaningfulDAta()
With ThisWorkbook
Set SrcSht = .Sheets("Sheet1")
Set DEstSht = .Sheets("Sheet2")
End With
Set SrcRange = SrcSht.Cells(1, 2).CurrentRegion
If SrcRange.Rows.Count > 1 Then
DestRow = 0
For Each SrcRow In SrcRange.Rows
ValidRow = True
For Each SrcCell In SrcRow.Cells
If IsError(SrcCell) Then
ValidRow = False
Else
Select Case IsNumeric(SrcCell)
Case True
If SrcCell = 0 Then ValidRow =
False
Case False
If SrcCell = "" Or IsError
(SrcCell) Then
ValidRow = False
End If
End Select
End If
Next
If ValidRow Then
DestRow = DestRow + 1
For Each SrcCell In SrcRow.Cells
DEstSht.Cells(DestRow, SrcCell.Column)
= SrcCell
Next
End If
Next
End If

End Sub

 

[Tom Ogilvy]

Another possibility:

Option Explicit

Sub CopyMeaningfulDAta()
Dim SrcSht As Worksheet, DEstSht As Worksheet
Dim rng as Range
With ThisWorkbook
Set SrcSht = .Sheets("Sheet1")
Set DEstSht = .Sheets("Sheet2")
End With
set rng = srcsht.columns(2).SpecialCells(xlFormulas,xltextvalues)
if Not rng is nothing then
rng.Entirerow.copy Destination:=DestSht.Range("A1")
End if
End Sub

 

[Slick Willie]

Or you could try something like this:
intCounter = 1
intNumRows = Worksheets("Sheet1").UsedRange.Rows.Count
intNumRows = intNumRows + 1
While intCounter <> intNumRows
If IsError(Sheets("Sheet1").Cells(intcounter, "A") Then
'Do Nothing
Else
'copy cells
End If
intCounter = intCounter+1
Wend

 

[Don Guillett]

A mod of this would be faster

Sub copycells()
On Error GoTo ItsOver
lr = Cells(Rows.Count, 2).End(xlUp).Row
With Range("A5:g" & lr)
..AutoFilter
..AutoFilter Field:=1, Criteria1:=">0", Operator:=xlAnd
rc = Application.Count(Range("A6:a" & lr).SpecialCells(xlCellTypeVisible))
Range("A6:g" & lr).SpecialCells(xlCellTypeVisible).Copy _
Sheets("yoursheet").Range("a15")
ItsOver:
..AutoFilter
Application.Goto Sheets("yoursheet").Range("a14"), scroll:=True
End With
End Sub