Ian
You can amend the sheet names to suit. Where I have Sheet1, amend it to read the name of the sheet
in which you have the code (don't forget the ""). Where I have sheet2, put the name of the other
sheet in your workbook.
Try this:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Worksheets("Sheet1")
If Not Application.Intersect(Target, .Range(.Columns(1), .Columns(5))) Is Nothing Then
Dim rG As Double, r As Double, cL As Double, cC As Integer, iRow As Double
rG = Target.Rows.Count
r = Target.Row
cL = Target.Column
Else
Exit Sub
End If
End With
For iRow = r To (r + (rG - 1))
With Worksheets("Sheet1")
cC = 0
For Each c In .Range(.Cells(iRow, 1), .Cells(iRow, 5)).Cells
cN = CStr(c)
If c <> CStr(0) And c <> "" And IsEmpty(c) = False And IsNumeric(cN) = True Then
cC = cC + 1
Else
Exit For
End If
Next c
If cC = 5 Then
myCop = True
Else
myCop = False
End If
End With
With Worksheets("Sheet2")
If myCop = True Then
If iRow = 1 Then GoTo noGo
If .Cells(iRow - 1, 1) <> "" Then
.Range(.Cells(iRow - 1, 1), .Cells(iRow - 1, 156)).Copy Destination:=.Cells(iRow, 1)
Else
rr = .Cells(iRow, 1).End(xlUp).Row
.Range(.Cells(rr, 1), .Cells(rr, 156)).Copy Destination:=.Cells(iRow, 1)
End If
ElseIf myCop = False Then
If iRow = 1 Then GoTo noGo
.Range(.Cells(iRow, 1), .Cells(iRow, 156)).ClearContents
Else
GoTo noGo
End If
noGo:
End With
Next iRow
Fin:
If iRow = 1 Then
Worksheets("Sheet1").Cells(iRow, cL + 1).Select
Else
Worksheets("Sheet1").Cells(iRow - 1, cL + 1).Select
End If
End Sub
Does that do it?
Regards
In Sheet1 A2 ~ E8 has links to data on other workbook that I copied and pasted, sometime the last few rows values are 0, (this happens only at the last few rows), and I want those rows that have positive values (the first few rows) to be auto formulated in sheet2 (drag and fill). Please let me know if yu need anymore info, Thanks
Sorry again, The code does not work, there is no drag and fill in Sheet2, i have change my first and second sheet to Sheet1 and Sheet2 but still not working. Is it possible for me to email you my file? Thanks for sparing your time on this issue
You can amend the sheet names to suit. Where I have Sheet1, amend it to read the name of the sheet
Ian
It certainly works for me so I don't know what is wrong at your end.
I have posted my email in the header this time so send me your workbook and I'll see
what I can do.
Regards
Thanks Robb, It works..............
It certainly works for me so I don't know what is wrong at your end. I have posted my email in the header this time so send me your workbook and I'll see
: Sorry again, The code does not work, there is no drag and fill in Sheet2, i have change my first and second sheet to Sheet1 and Sheet2 but still not working. Is it possible for me to email you my file? Thanks for sparing your time on this issue :