Solved: Auto Copy & Paste when a certain condition is met.

[countryfan_n]

Hello friends,


The below attachment should make request easier to understand.
I am truly sorry for the inconvenience

I am trying to create a macro that:
1. Would look into rows 3 or 4 or 5 or 6 or 7.
2. And if the value in G3 or G4 or G5 or G6 or G6 or G7 = 100%

Then the:
3. Entire row of that active cell would be copied & pasted to C11:H11.
4. Clear the data in the top rows (since it has already been pasted to a new row).
5. Please note the pasting should only occur from row number B11.
6. If the row B11 already is filled up, then pasting should be applied to the following empty row and so forth.


Thanks in advance,
Nawaf

[Bob Phillips]

Sub CopyData()
Dim i As Long
Dim NextRow As Long

With ActiveSheet

NextRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
If NextRow < 11 Then NextRow = 11
For i = 3 To 7

If .Cells(i, "G").Value = 1 Then

.Cells(i, "B").Resize(, 7).Copy .Cells(NextRow, "B")
.Cells(i, "B").Resize(, 7).Delete Shift:=xlUp
End If
Next i
End With
End Sub

[Tommy]

Another way


Sub Main()
Dim cntr As Integer, toCntr As Integer
toCntr = 11
For cntr = 3 To 7
If ActiveSheet.Cells(cntr, 7).Value = 100 Then
CopyRow cntr, toCntr
End If
Next
End Sub
Sub CopyRow(RowId As Integer, ToRowId As Integer)
Dim RowStr As String
Dim RowToStr As String
'copy from row
RowStr = CStr(RowId)
'copt to row
RowToStr = CStr(ToRowId)
'do the copy
ActiveSheet.Range("C" & RowStr & ":H" & RowStr).Copy _
Destination:=ActiveSheet.Range("C" & RowToStr)
'clear the copied row
ActiveSheet.Range("C" & RowStr & ":H" & RowStr).ClearContents
'incrament copy to row
ToRowId = ToRowId + 1
End Sub

[Tommy]

Sorry wrong value check


Sub Main()
Dim cntr As Integer, toCntr As Integer
toCntr = 11
For cntr = 3 To 7
If ActiveSheet.Cells(cntr, 7).Value = 1 Then
CopyRow cntr, toCntr
End If
Next
End Sub