VBA to Move Partial Row to Another Table on a new Sheet

moonshineal04

New Member
Joined
Mar 23, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hi there,
I am very new to VBA and I am having trouble finding a code to accomplish what I need. I have found several codes that will move an entire row to a new sheet but I need to move only part of a row to a new sheet.

I want the code to move any row that says Expired in column H to the table from "Test Table A" to the table on "Test Table B". However I only need columns A - H moved to the new sheet.
1616526434404.png


NEW SHEET:
1616526404561.png

I want the data to show up on the next available row in column E-L.

So essentially it is copying and pasting a partial row to the new table (in different columns) and then deleting the original row on the first sheet.

This is how each sheet should look after the VBA moves the data:
Test Table A:
1616526650442.png

Test Table B:
1616526767329.png

Can someone help me figure out how to accomplish this?

Thanks so much! Let me know if I need to clarify my question!
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

jsb1921

Board Regular
Joined
Aug 14, 2020
Messages
70
Office Version
  1. 2007
Platform
  1. Windows
  2. Web
VBA Code:
Sub s_move_expired_a_to_b()
    Dim i_last_row_tbl_a As Integer, i_last_row_tbl_b As Integer
    Dim i_curr_row_tbl_a As Integer
    Dim int1 As Integer
    Dim str1 As String
  
    Sheets("Test Table B").Select
    i_last_row_tbl_b = Cells(Rows.Count, "E").End(xlUp).Row
  
    Sheets("Test Table A").Select
    i_last_row_tbl_a = Cells(Rows.Count, "H").End(xlUp).Row
  
    For int1 = i_last_row_tbl_a To 3 Step  -1
        str1 = Sheets("Test Table A").Cells(int1, "H").Value
        If str1 = "Expired" Then
            i_last_row_tbl_b = i_last_row_tbl_b + 1
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "E").Value = Sheets("Test Table A").Cells(int1, "A").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "F").Value = Sheets("Test Table A").Cells(int1, "B").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "G").Value = Sheets("Test Table A").Cells(int1, "C").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "H").Value = Sheets("Test Table A").Cells(int1, "D").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "I").Value = Sheets("Test Table A").Cells(int1, "E").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "J").Value = Sheets("Test Table A").Cells(int1, "F").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "K").Value = Sheets("Test Table A").Cells(int1, "G").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "L").Value = Sheets("Test Table A").Cells(int1, "H").Value
            Sheets("Test Table A").Rows(int1).EntireRow.Delete
        Else
        End If
    Next int1
End Sub
 

moonshineal04

New Member
Joined
Mar 23, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
VBA Code:
Sub s_move_expired_a_to_b()
    Dim i_last_row_tbl_a As Integer, i_last_row_tbl_b As Integer
    Dim i_curr_row_tbl_a As Integer
    Dim int1 As Integer
    Dim str1 As String
 
    Sheets("Test Table B").Select
    i_last_row_tbl_b = Cells(Rows.Count, "E").End(xlUp).Row
 
    Sheets("Test Table A").Select
    i_last_row_tbl_a = Cells(Rows.Count, "H").End(xlUp).Row
 
    For int1 = i_last_row_tbl_a To 3 Step  -1
        str1 = Sheets("Test Table A").Cells(int1, "H").Value
        If str1 = "Expired" Then
            i_last_row_tbl_b = i_last_row_tbl_b + 1
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "E").Value = Sheets("Test Table A").Cells(int1, "A").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "F").Value = Sheets("Test Table A").Cells(int1, "B").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "G").Value = Sheets("Test Table A").Cells(int1, "C").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "H").Value = Sheets("Test Table A").Cells(int1, "D").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "I").Value = Sheets("Test Table A").Cells(int1, "E").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "J").Value = Sheets("Test Table A").Cells(int1, "F").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "K").Value = Sheets("Test Table A").Cells(int1, "G").Value
            Sheets("Test Table B").Cells(i_last_row_tbl_b, "L").Value = Sheets("Test Table A").Cells(int1, "H").Value
            Sheets("Test Table A").Rows(int1).EntireRow.Delete
        Else
        End If
    Next int1
End Sub
First off, this is Awesome! And thank you so much for taking your time to provide me this this code! However, I realize now I may have not included an essential piece of the puzzle so the code is working to move the written data but not the linked data. On the actual document I am working on, two of my columns include either a hyperlink or directly link to another sheet.

Example:
See in Manager Column, it links to the related tabs below.
1616539514372.png


Then on the tabs, I have the date linked to the Test Table A data:
1616539651673.png


If I manually copy and paste those cells, the links remain:
1616539900482.png


1616539933934.png


However, when I use the Macro, it doesn't copy over the links:

1616540180907.png


1616540208901.png


So is there a code that cuts or copies the actual data with links rather than the value?

Thanks so much for you time!
 

Watch MrExcel Video

Forum statistics

Threads
1,129,816
Messages
5,638,496
Members
417,029
Latest member
lingx86

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top