Excel Macro Help Closed

Question

Hello,

I am using Excel 2007.

I need a macro that will cut and paste certain cells from a row based on a cell value in that row. What is cut will be pasted to a different sheet based on the cell value. The original row will be deleted and removed.

Source Sheet is "Applications"
Destination Sheet 1 is "Fundings"
Destination Sheet 2 is "Denials"

If the value in Column G is "Funded" Move columns A:H from active row to first empty row on destination sheet 1.
If the value in Column G is "Denied" Move columns A:H from active row to first empty row on destination sheet 2.

1. Source sheet has headings in row 1 and 2 so it will start checking the data in row 3.
2. Column G does have empty cells.
3. Destination sheet has headings in row 1 and 2 so the data will start pasting in the first available row after the third row. 

I want to assign this macro to the "F10" Key

Please advise.

venkat1926 · Answer

try this macro and assign any key to this 
(you must be already having sheets "applications","funded" and denied"

Sub test()
Dim rng As Range, c As Range, dest As Range
With Worksheets("applications")
Set rng = Range(.Range("G3"), .Cells(Rows.Count, "G").End(xlUp))
For Each c In rng
If c = "funded" Then
c.EntireRow.Copy
With Worksheets("funding")
Set dest = .Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With
ElseIf c = "denied" Then
c.EntireRow.Copy
With Worksheets("denied")
Set dest = .Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With
End If
Next c
End With
Application.CutCopyMode = False
End Sub

Anonymous · Answer

That worked great.

However, I really need it to cut and paste rather than copy and paste, and/or delete the original row and shift cells up on original worksheet.

Is there any way to do that?

venkat1926 · Answer

modified macro is 

Sub test()
Dim rng As Range, c As Range, dest As Range
Dim j As Integer, k As Integer, rng1 As Range
With Worksheets("applications")
Set rng = Range(.Range("G3"), .Cells(Rows.Count, "G").End(xlUp))
For Each c In rng
If c = "funded" Then
c.EntireRow.Copy
With Worksheets("funding")
Set dest = .Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With
ElseIf c = "denied" Then
c.EntireRow.Copy
With Worksheets("denied")
Set dest = .Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
dest.PasteSpecial
End With
End If
Next c
'===========addition
j = .Cells(Rows.Count, "G").End(xlUp).Row
For k = j To 3 Step -1
Set rng1 = .Cells(k, "g")
If rng1 = "funded" Or rng1 = "denied" Then
rng1.EntireRow.Delete
End If
Next k


End With
Application.CutCopyMode = False
End Sub

Excel Macro Help

3 responses

Similar discussions

Subscribe To Our Newsletter!