Solved: Copy entire row to new worksheet on found cell

[tlchan]

I expect to copy entire row of data in sheet(ALLSSE) if the cell value under column "I" in sheets (ALLSSE) is empty to new worksheet to be named by monthname. (macro -module 4)


Secondly I also to perform the same task if the cell value under column "I" sheet(ALLSSE) is not empty to another new worksheet to be named differently. (Macro-module 5)


The problems are the macros only copy 1 or 2 match cell value only. Can anyone able to assist me to overcome the problem to get the expected result ?

Thanks in anticipation:dunno

[Aussiebear]

Option Explicit

Sub Process(ByVal Target As Range)
Dim i As Integer
For i = 1 To Selection.CurrentRegion.Rows.Count - 1

If Target.Column = 9 And Target.Row > 1 Then
If Target <> " " Then DoWithdrawn Target
If Target = " " Then DoClear Target
End If
Next i

On Error GoTo 0

End Sub

Sub DoWithdrawn(Target As Range)
Dim lRow As Long
Dim cRow As Long
lRow = Sheets("WdnSSE As AtAugust 08").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
With ActiveSheet
Range(.Cells(Target.Row, 1).Cells(Target.Row, 12)).Copy
With Sheets("WdnSSE As AtAugust 08")
.Range(.Cells(lRow, 1), .Cells(lRow, 12)).PasteSpecial xlValues
.Range(.Cells(lRow - 1, 1).Cells(lRow - 1, 12)).Copy
.Range(.Cells(lRow, 1), .Cells(lRow, 12)).PasteSpecial xlFormats
End With
Application.CutCopyMode = False
cRow = Target.Row
.Range.EntireRow.Delete
End With

End Sub

Sub DoClear(Target As Range)
Dim lRow As Long
Dim cRow As Long
lRow = Sheets("SSE As AtAugust 08").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
With ActiveSheet
Range(.Cells(Target.Row, 1).Cells(Target.Row, 12)).Copy
With Sheets("WdnSSE As AtAugust 08")
.Range(.Cells(lRow, 1), .Cells(lRow, 12)).PasteSpecial xlValues
.Range(.Cells(lRow - 1, 1).Cells(lRow - 1, 12)).Copy
.Range(.Cells(lRow, 1), .Cells(lRow, 12)).PasteSpecial xlFormats
End With
Application.CutCopyMode = False
cRow = Target.Row
.Range.EntireRow.Delete
End With
End Sub



The above code is an example only ( definitely not tested) and should give you an idea as to how it might look. Its been adapted form some code provided to me for another purpose.

[Aussiebear]

Try this as an alternative to the above code.

Option Explicit

Sub Process()
Dim LastRow As Long
Dim i As Long

With Worksheets("WdnSSE As AtAugust 08")

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows("3:" & LastRow).ClearContents
End With

With Worksheets("SSE As AtAugust 08")

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows("2:" & LastRow).ClearContents
End With

With Worksheets("ALLSSE")

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow

If .Cells(i, 9).Value <> "" Then

DoCopy Sheets("WdnSSE As AtAugust 08"), .Cells(i, "A").Resize(, 8)
Else

DoCopy Sheets("SSE As AtAugust 08"), .Cells(i, "A").Resize(, 8)
End If
Next i
End With

On Error Goto 0

End Sub

Sub DoCopy(sh As Worksheet, Target As Range)
Dim lRow As Long
Dim cRow As Long
With sh

lRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Row
Target.Copy .Cells(lRow, "A")
End With

End Sub

[tlchan]

Thanks Aussiebear for your solution. Both options works. The only difference is your code copy row to static named sheet instead of dynamic named sheet which to be determined by date. However your solution is sufficient to perform the task as the dynamic sheet name is not my priority which also will end up with too many sheets.

Thanks again for your great help.:hi: