Solved: Search rows and copy and save them

[Nicolaf]

Hi,

I would like to create a VBA macro that goes through an Excel s/s in Sheet1 looks for rows where first Cell is "A" and then copies whole row in Sheet2.

Let's suppose there are 4 rows as follows:

A 1
B 2
A 3
C 4

I would like to copy first and third row into Sheet2

How can I do that?

Thanks!
Nic

[Aussiebear]

Just copies the row into sheet 2 or copies and deletes the row just copied?

[GTO]

Hi Nicolaf,

Just until you answer Ted's question, this may or may not be in the neighborhood. I was playing a bit... This should "copy" the values, but limits to the last used column of Sheet1.

I used the codenames.

Option Explicit

Sub CopySelectRows()
Dim _
lLRow As Long, _
lLCol As Long, _
lFRow As Long, _
rRow As Range, _
rRange As Range

With Sheet1

If .Cells.Find("*", .Cells(1, 1), xlValues, xlPart, xlByRows, xlPrevious) _
Is Nothing Then Exit Sub

lLRow = .Cells.Find( _
"*", .Cells(1, 1), xlValues, xlPart, xlByRows, xlPrevious _
).Row
lLCol = .Cells.Find( _
"*", .Cells(1, 1), xlValues, xlPart, xlByColumns, xlPrevious _
).Column

Set rRange = .Range("A1:A" & lLRow)

For Each rRow In rRange
If UCase(rRow.Value) = "A" Then
With Sheet2
If .Cells.Find( _
"*", .Cells(1, 1), xlValues, xlPart, xlByRows, xlPrevious _
) Is Nothing Then
lFRow = 1
Else
lFRow = .Cells.Find( _
"*", .Cells(1, 1), xlValues, xlPart, xlByRows, xlPrevious _
).Row + 1
End If

.Range(.Cells(lFRow, 1), .Cells(lFRow, lLCol)).Value = _
rRow.Resize(1, lLCol).Value
End With
End If
Next
End With
End Sub


Hope this helps,

Mark

[Nicolaf]

Just copies the row in sheet2 !

[Nicolaf]

Hi Mark,

Works fine.

Thanks!
Nic :hi: