VBA Cut and Paste Data From One Sheet to appropriate Sheet based on FY Date

[TimPin]

Hello, I am hoping someone can help me with my dilemma, I don't even know where to begin coding this one.

I have a Workbook with 6 Sheets: TRACKER, FY19 SUMMARY, FY20 SUMMARY, FY21 SUMMARY, FY22 SUMMARY, FY23SUMMARY, and FY24 SUMMARY.

I need to move a portion of a row of data from the TRACKER worksheet to the appropriate FY SUMMARY worksheet based on Fiscal Year. There is a macro to place a Check Mark Symbol in columns E-I when clicked and a formula to calculate Expiration Date in Column K and Fiscal Year in Column M.

I need to append the cells in Columns A-L after the last row of data in appropriate Fiscal year worksheet when Column L is populated, I don't want any formatting or formulas to be copied, only the contents.

Each of the columns A-M have a header in Row 1 and each of the FY SUMMARY sheets have the same headers for rows A-L (Fiscal Year not copied).

I am going to place a Macro Button in the spreadsheet to perform the operation.

Any help would be greatly appreciated.

My TRACKER Sheet looks like this.

A B C D E F G H I J K L M

Last Name

First Name

Rank

Unit

Member Sig.

Unit Com. Sig.

Group Com. Sig

MSG/Wing Com. Sig

SVS Approval

Approval Date

Expiration Date

Check Out Date

Fiscal Year

Smith

John

Pvt.

199

X

X

X

X

X

4/1/2019

5/16/2019

4/22/2019

2019

<tbody>
</tbody>

 

[TimPin]

My button name is Archive. Thanks again!

 

[mumps]

Try running the macro I posted in Post# 10 manually without using the button. You can do that by pressing the F5 key in the Visual Basic Editor. If it still doesn't work, perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[TimPin]

My Excel File is located Here. https://www.dropbox.com/s/2d8mlvhsm5ozk29/Exception to Policy Tracker-v1_4.xlsm?dl=0


Thank You!

 

[mumps]

Try:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, rng As Range, LastRow As Long
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For Each rng In Range("L2:L" & LastRow)
        If rng <> "" Then
            Set desWS = Sheets("FY" & Right(rng.Offset(0, 1), 2) & " SUMMARY")
            Range("A" & rng.Row).Resize(, 12).Copy
            desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next rng
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[TimPin]

That works great with one exception. I need it to delete the data on the TRACKER after it has been moved.

 

[mumps]

Try:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim desWS As Worksheet, x As Long, LastRow As Long
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For x = LastRow To 2 Step -1
        If Cells(x, 12) <> "" Then
            Set desWS = Sheets("FY" & Right(Cells(x, 13), 2) & " SUMMARY")
            Range("A" & x).Resize(, 12).Copy
            desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            ActiveSheet.Range("A" & x).Resize(, 13).Delete
        End If
    Next x
    Application.CutCopyMode = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[TimPin]

That is AWESOME, works exactly as I wanted. Thank you VERY much!!!

 

[mumps]

You're welcome.