C
coperniq
Hi ;
I couldn't find a way to copy specific cells in an excel sheet, move
(copy) them to another sheet and leave the originals. (So ı don't
want to cut)
I have found Dave's macro which is really great. But on the other hand,
the problem is, it clears content that is moved.
(FoundCell.ClearContents) But I want to change it to (FoundCell.Copy)
without an infinite loop as you should
_keep_track_of_the_address_of_the_first_found_cell_to_stop_macro_searching_the_defined_cell_again_and_again._
So Could anyone please advise me how to? I have really tried hard but
always get another error message
Thanx for your interest.
cop.
Dave Peterson's Macro Code:
Option Explicit
Sub testme()
Dim myWords As Variant
Dim curWks As Worksheet
Dim newWks As Worksheet
Dim FoundCell As Range
Dim iCtr As Long
Dim oRow As Long
myWords = Array("asdf8", "asdf24", "asdf33")
Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add
oRow = 0
With curWks
For iCtr = LBound(myWords) To UBound(myWords)
Set FoundCell = Nothing
Do
With .UsedRange
Set FoundCell = .Cells.Find(what:=myWords(iCtr), _
after:=.Cells(.Cells.Count), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False)
If FoundCell Is Nothing Then
Exit Do
Else
oRow = oRow + 1
With newWks.Cells(oRow, "A")
..Value = myWords(iCtr)
..Offset(0, 1).Value = FoundCell.Address
End With
_FoundCell.ClearContents_
End If
End With
Loop
Next iCtr
End With
End Sub
I couldn't find a way to copy specific cells in an excel sheet, move
(copy) them to another sheet and leave the originals. (So ı don't
want to cut)
I have found Dave's macro which is really great. But on the other hand,
the problem is, it clears content that is moved.
(FoundCell.ClearContents) But I want to change it to (FoundCell.Copy)
without an infinite loop as you should
_keep_track_of_the_address_of_the_first_found_cell_to_stop_macro_searching_the_defined_cell_again_and_again._
So Could anyone please advise me how to? I have really tried hard but
always get another error message
Thanx for your interest.
cop.
Dave Peterson's Macro Code:
Option Explicit
Sub testme()
Dim myWords As Variant
Dim curWks As Worksheet
Dim newWks As Worksheet
Dim FoundCell As Range
Dim iCtr As Long
Dim oRow As Long
myWords = Array("asdf8", "asdf24", "asdf33")
Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add
oRow = 0
With curWks
For iCtr = LBound(myWords) To UBound(myWords)
Set FoundCell = Nothing
Do
With .UsedRange
Set FoundCell = .Cells.Find(what:=myWords(iCtr), _
after:=.Cells(.Cells.Count), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False)
If FoundCell Is Nothing Then
Exit Do
Else
oRow = oRow + 1
With newWks.Cells(oRow, "A")
..Value = myWords(iCtr)
..Offset(0, 1).Value = FoundCell.Address
End With
_FoundCell.ClearContents_
End If
End With
Loop
Next iCtr
End With
End Sub