copy adjacent cells also and put totals at the end (for copied cel
I don't believe VBA recognizes terms like "few" and "some". If you want to
copy more than one cell at a time, then you will need to furnish the criteria
that determines when to do that, AND the criteria that determines how many
addiditional cells are to be copied, AND wher the data is located that you
want summarized. VBA needs to be told specifically what to do, it cannot
operate on vague generalities.
"Eddy Stan" wrote:
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
|