View Full Version : Solved: Copy entire row to new worksheet on found cell
tlchan
08-28-2008, 04:10 AM
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
08-28-2008, 07:38 AM
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
08-29-2008, 02:22 AM
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
08-29-2008, 07:23 PM
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:
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.