whitoulias
Board Regular
- Joined
- Jun 22, 2012
- Messages
- 153
Good day everyone
I have this code (command button1) which works just fine. What it does is if cell 02 in sheet1 is "14" then it copies the entire row to sheet2. The same goes for all O column
I would like to change it a little bit.
Instead of copy i would like to cut the row, paste it in sheet2 and shift cells up in sheet1
Any ideas.
Thank u in advance
I have this code (command button1) which works just fine. What it does is if cell 02 in sheet1 is "14" then it copies the entire row to sheet2. The same goes for all O column
I would like to change it a little bit.
Instead of copy i would like to cut the row, paste it in sheet2 and shift cells up in sheet1
Any ideas.
Thank u in advance
Code:
Private Sub CommandButton1_Click()
Dim FirstAddress As String
Dim myArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long
Dim LastCol As String
Application.ScreenUpdating = False
myArr = Array("14")
Rcount = 0
With Sheets("Sheet1").Range("O1:O1000")
For I = LBound(myArr) To UBound(myArr)
Set Rng = .Find(What:=myArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 2
LastCol = Chr(Worksheets("Sheet1").Range("A" & Rng.Row).End(xlToRight).Column + 64)
Worksheets("Sheet1").Range("A" & Rng.Row & ":" & LastCol & Rng.Row).Copy _
Destination:=Worksheets("Sheet2").Range("A" & Rcount)
'Sheets("Sheet2").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
Application.ScreenUpdating = True
End Sub
