NewUser598
New Member
- Joined
- Dec 4, 2009
- Messages
- 13
I am trying to declare a variable that i can reference a cell value to activate then copy that value to another range of cells. My effort so far has been faulty. This is what Ive done so far:
Sub ReplaceFormat()
Dim First As Integer
First = Range("A3").Value
Set FoundCell = First
Application.ReplaceFormat.Interior.ColorIndex = 3 '(Red)
Cells.Replace What:="First", Replacement:="First", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, _
SearchFormat:=False, ReplaceFormat:=True
If FoundCell = First Then
FoundCell.Select
Selection.Copy Destination:=Cells(MyDataRow, 10)
ActiveCell.Offset(-1, -1).Copy Destination:=Cells(MyDataRow, 11)
On Error Resume Next
ActiveCell.Offset(0, -1).Copy Destination:=Cells(MyDataRow, 12)
On Error Resume Next
ActiveCell.Offset(1, -1).Copy Destination:=Cells(MyDataRow, 13)
On Error Resume Next
ActiveCell.Offset(1, 0).Copy Destination:=Cells(MyDataRow, 14)
On Error Resume Next
ActiveCell.Offset(1, 1).Copy Destination:=Cells(MyDataRow, 15)
On Error Resume Next
ActiveCell.Offset(0, 1).Copy Destination:=Cells(MyDataRow, 16)
On Error Resume Next
ActiveCell.Offset(-1, 1).Copy Destination:=Cells(MyDataRow, 17)
On Error Resume Next
ActiveCell.Offset(-1, 0).Copy Destination:=Cells(MyDataRow, 18)
On Error Resume Next
MyDataRow = MyDataRow + 1
End If
End Sub
Any recomendations as to how to make this work?
Sub ReplaceFormat()
Dim First As Integer
First = Range("A3").Value
Set FoundCell = First
Application.ReplaceFormat.Interior.ColorIndex = 3 '(Red)
Cells.Replace What:="First", Replacement:="First", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, _
SearchFormat:=False, ReplaceFormat:=True
If FoundCell = First Then
FoundCell.Select
Selection.Copy Destination:=Cells(MyDataRow, 10)
ActiveCell.Offset(-1, -1).Copy Destination:=Cells(MyDataRow, 11)
On Error Resume Next
ActiveCell.Offset(0, -1).Copy Destination:=Cells(MyDataRow, 12)
On Error Resume Next
ActiveCell.Offset(1, -1).Copy Destination:=Cells(MyDataRow, 13)
On Error Resume Next
ActiveCell.Offset(1, 0).Copy Destination:=Cells(MyDataRow, 14)
On Error Resume Next
ActiveCell.Offset(1, 1).Copy Destination:=Cells(MyDataRow, 15)
On Error Resume Next
ActiveCell.Offset(0, 1).Copy Destination:=Cells(MyDataRow, 16)
On Error Resume Next
ActiveCell.Offset(-1, 1).Copy Destination:=Cells(MyDataRow, 17)
On Error Resume Next
ActiveCell.Offset(-1, 0).Copy Destination:=Cells(MyDataRow, 18)
On Error Resume Next
MyDataRow = MyDataRow + 1
End If
End Sub
Any recomendations as to how to make this work?