E
Eddy Stan
Hi
the following code finds cells and copies, but for one column only.
(1) i want to copy adjacents cells of the found cells, using offset ?
how can i do that?
(2) and sum at the end for few few columns
(3) one find is made at 1 column only but i need to find for 2, in two
columns, if both match (in the same row) then some adjacent cells of the
found cells have to be copied to another formatted sheet after row 15
------------------------------------------------------------
I took the code from "Ron", fyi. thanks - Eddy stan
Sub Copy_To_Another_Sheet_1()
Dim FirstAddress As String
Dim MyArr As Variant ' setting any array as variable
Dim Rng As Range
Dim Rng2 As Range
Dim Rcount As Long
Dim I As Long
Dim NewSh As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Fill in the search Value
' MyArr = Array("@")
'You can also use more values in the Array
' MyArr = Array("@", ".www")
MyArr = Array(Range("F1").Value, Range("F2").Value)
'Add new worksheet to your workbook to copy to
' Set NewSh = Worksheets.Add
'You can also use a existing sheet like this
Set NewSh = Sheets("Customer")
With Sheets("Duelist").Range("A1:d159")
' Rcount = 0
Rcount = 15 ' leave top 15 rows.
For I = LBound(MyArr) To UBound(MyArr)
'If you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "@"
'Note : I use xlPart in this example and not xlWhole
Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 1
Rng.Copy NewSh.Range("A" & Rcount)
' Use this if you only want to copy the value
' NewSh.Range("A" & Rcount).Value = Rng.Value
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
the following code finds cells and copies, but for one column only.
(1) i want to copy adjacents cells of the found cells, using offset ?
how can i do that?
(2) and sum at the end for few few columns
(3) one find is made at 1 column only but i need to find for 2, in two
columns, if both match (in the same row) then some adjacent cells of the
found cells have to be copied to another formatted sheet after row 15
------------------------------------------------------------
I took the code from "Ron", fyi. thanks - Eddy stan
Sub Copy_To_Another_Sheet_1()
Dim FirstAddress As String
Dim MyArr As Variant ' setting any array as variable
Dim Rng As Range
Dim Rng2 As Range
Dim Rcount As Long
Dim I As Long
Dim NewSh As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Fill in the search Value
' MyArr = Array("@")
'You can also use more values in the Array
' MyArr = Array("@", ".www")
MyArr = Array(Range("F1").Value, Range("F2").Value)
'Add new worksheet to your workbook to copy to
' Set NewSh = Worksheets.Add
'You can also use a existing sheet like this
Set NewSh = Sheets("Customer")
With Sheets("Duelist").Range("A1:d159")
' Rcount = 0
Rcount = 15 ' leave top 15 rows.
For I = LBound(MyArr) To UBound(MyArr)
'If you use LookIn:=xlValues it will also work with a
'formula cell that evaluates to "@"
'Note : I use xlPart in this example and not xlWhole
Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 1
Rng.Copy NewSh.Range("A" & Rcount)
' Use this if you only want to copy the value
' NewSh.Range("A" & Rcount).Value = Rng.Value
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub