How do I get this macro to start the search in the second row

J

Journey

I have the following code. It loops through and searches each row in sheet1.
If it find and asterick in column M on sheet 1, it will append the row to
sheet 2.

First, How can I get it to start the search loop at row 2 because row 1 is
the header information. Second, how to I get it to paste only information
from columns A, B, F, G, and H to sheet 2.

Public Sub CopyStuff()
Dim wksFrom As Worksheet
Dim wksTo As Worksheet
Dim rngFound As Range
Dim rngFoundAll As Range
Dim rngToSearch As Range
Dim strFirstAddress As String

Set wksFrom = Sheets("Sheet1") 'copy from worksheet
Set wksTo = Sheets("Sheet2") 'copy to worksheet
Set rngToSearch = wksFrom.Columns("M") 'Asterick ("*") in this column
denotes a change or addition
Set rngFound = rngToSearch.Find(What:="*", _
LookAt:=xlWhole, _
LookIn:=xlValues, _
MatchCase:=True)
If rngFound Is Nothing Then
MsgBox "Asterick (" * ") was not found"
Else
strFirstAddress = rngFound.Address
Set rngFoundAll = rngFound
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
rngFoundAll.EntireRow.Copy _
wksTo.Cells(Rows.Count, "A").End(xlUp).Offset(0, 0)
End If
End Sub
 
M

Mike H.

This would work:

Option Explicit
Option Base 1

Sub CopyCertainStuff()
Dim X As Double
Dim Dataarray(50000, 5) As Variant
Dim Fnd As Double
Dim Y As Double
Dim Z As Double

X = 2
Do While True
If Cells(X, 1).Value = Empty Then Exit Do 'or whatever else you need to
do to stop at the bottom row!
If InStr(Cells(X, 13).Value, Chr(42)) > 0 Then
'found one
Fnd = Fnd + 1
Dataarray(Fnd, 1) = Cells(X, 1).Value
Dataarray(Fnd, 2) = Cells(X, 2).Value
Dataarray(Fnd, 3) = Cells(X, 6).Value
Dataarray(Fnd, 4) = Cells(X, 7).Value
Dataarray(Fnd, 5) = Cells(X, 8).Value
Else
Beep
End If
X = X + 1

Loop

If Fnd > 0 Then
Sheets("Sheet2").Select
Range("A65000").End(xlUp).Select 'this is a row with data, this row +1
is empty!
'or adjust 65000 if you are using xlsx or .xlsm files!
X = ActiveCell.Row
For Z = 1 To Fnd
X = X + 1
For Y = 1 To 5
Cells(X, Y).Value = Dataarray(Z, Y)
Next
Next
End If


End Sub
 

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

Similar Threads

find multiple values code tweak 5
help with macro 9
Find next problem 1
cut rows to another sheet if a specific cell NOT BLANK 3
Cut instead of Copy 7
Find "Not Equal" 0
findnext error in loop 2
change code 2

Top