Looking for VBA code OR formula to copy and paste from one sheet to another

[Jackerson615]

Thank you in advance for any help you all can offer! I’ll judt list out what I need to do below.

Sheet 1 (this is my master log/source table)
contains a table in which I manually input data Daily under the following headers
A B. C. D. E
1 DATE CLIENT DEAL# LENDER STATUS

2. Feb 1 SMITH. 3445. Chase. Funddelay

Sheet 2
Contains 3 separate tables arranged exactly how it is above BUT each table has a different name “Funding Delay”, “Contract Resigns” and “Stips Required” Example below

“Funding Delay”
A B. C. D. E
1 DATE CLIENT DEAL# LENDER STATUS
2

What I would like To happen is the following

If sheet 1 Column E (status) contains “funding delay” then I would like to copy and paste the data into sheet 2 “Funding Delay” Table.

Also perform the same task above for status that contains “contract resigns” and “Stips Required”and place copy’s of those data rows into the appropriate labeled table on sheet 2!

Lastly I will be updating the status on sheet 1 as necessary..so when the status changes on sheet 1 I would like the data to be removed from the applicable table on sheet 2. But remain logged in its new status on my master log (sheet 1)

Hopefully I explained this well enough! Thank you all for the help in advance!

 

[igold]

Hi Jackerson615,

Welcome to the MrExcel Forum.


This code should work provided that you are really working with Tables and not just ranges of data and that the following is adhered to.

1) You did not supply a name for your master log/source table, I used "Table1". You will have to change either the code (in the proper places) or your table name to match. Changing your table name would probably be the easiest.
2) You gave the table names on Sheet2 as two words which are not valid names for a table. I have put an underscore between the words of the name. For example, you have "Funding Delay", that now becomes "Funding_Delay", etc.
3) You flip flopped on what will appear in the status column of your main table as far as capitalization goes. All status must be in Proper Case (ie, "Contract Resigns" not "contract resigns")

When you change a status on the Main Table all of the other tables get rewritten with the current information from the Main Table. The code should be placed in the "Sheet1" module.

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim tbl1 As ListObject: Set tbl1 = ActiveSheet.ListObjects("Table1")
    Dim tblFD As ListObject: Set tblFD = Worksheets("Sheet2").ListObjects("Funding_Delay")
    Dim tblCR As ListObject: Set tblCR = Worksheets("Sheet2").ListObjects("Contract_Resigns")
    Dim tblSR As ListObject: Set tblSR = Worksheets("Sheet2").ListObjects("Stips_Required")
    Dim status As String, x As Long
    
    If Not Intersect(Target, tbl1.Range) Is Nothing Then
    Application.ScreenUpdating = False
    
        With tblFD.DataBodyRange
            If .Rows.Count > 1 Then
                .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
            End If
        End With
        
        With tblCR.DataBodyRange
            If .Rows.Count > 1 Then
                .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
            End If
        End With
        
        With tblSR.DataBodyRange
            If .Rows.Count > 1 Then
                .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
            End If
        End With
        
        For x = 1 To tbl1.Range.Rows.Count
            status = tbl1.DataBodyRange(x, 5)
            
            Select Case status
                Case Is = "Funding Delay"
                    tblFD.ListRows.Add alwaysinsert:=True
                    tbl1.ListRows(x).Range.Copy tblFD.DataBodyRange(tblFD.ListRows.Count - 1, 1)
                    
                Case Is = "Contract Resigns"
                    tblCR.ListRows.Add alwaysinsert:=True
                    tbl1.ListRows(x).Range.Copy tblCR.DataBodyRange(tblCR.ListRows.Count - 1, 1)
                    
                Case Is = "Stips Required"
                    tblSR.ListRows.Add alwaysinsert:=True
                    tbl1.ListRows(x).Range.Copy tblSR.DataBodyRange(tblSR.ListRows.Count - 1, 1)
            
            End Select
        Next
        Application.ScreenUpdating = True
    End If
    
End Sub

I hope this helps.