Excel Macro Help

Closed
Report
-
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
-
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.

3 replies

Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
803
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
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2821 users have said thank you to us this month

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?
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
803
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