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

[moonshineal04]

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.

NEW SHEET:

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:

Test Table B:

Can someone help me figure out how to accomplish this?

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

 

[jsb1921]

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]

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.

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

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

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

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

Thanks so much for you time!

 

[larrissag]

@jsb1921 I have a similar question, though my use is not as complex as moonshineal04. What do you suggest to modify this code

Rows(RowCount).Copy DestinationSheet.Range("A" & NextRowInDestinationSheet)

So that instead of moving the whole row to the destination sheet, it only moves B:H (or B on) and lands on the destination sheet B:H? (hopefully this snippet shows enough of the operation in question)

Thanks!

 

[larrissag]

@jsb1921 I have a similar question, though my use is not as complex as moonshineal04. What do you suggest to modify this code

Rows(RowCount).Copy DestinationSheet.Range("A" & NextRowInDestinationSheet)

So that instead of moving the whole row to the destination sheet, it only moves B:H (or B on) and lands on the destination sheet B:H? (hopefully this snippet shows enough of the operation in question)

Thanks!

Here is the rest of the code for context:

Sub SearchingSub()
'
Dim LastRowInColumn As Long
Dim NextRowInDestinationSheet As Long
Dim RowCount As Long
'
NextRowInDestinationSheet = 7
'
With SourceSheet
LastRowInColumn = .Range("A" & Rows.Count).End(xlUp).Row
'
For RowCount = 1 To LastRowInColumn '
If .Range("A" & RowCount) Like SearchString Then
.Rows(RowCount).Copy DestinationSheet.Range("A" & NextRowInDestinationSheet)
NextRowInDestinationSheet = NextRowInDestinationSheet + 1
End If '
Next RowCount
End With
End Sub

(I did not write this, I must give credit to another forum guru who did this for me!)

 

[larrissag]

@jsb1921 PLEASE disregard my previous question. I think I found a work around...but I'm trying to get the logic straight to come up with the code.

If column A contains 'total', then copy column F to column I & copy column G to column J

meaning it searches column A, finds 'total' on row 8, then it takes what's in F8 and copies it to I8 and takes what's in G8 and copies to J8.

I need to perform this on every sheet in the workbook (it's only going to perform once on each sheet).

I haven't come across this yet in my meager vba experience, I'm struggling to come up with how it would look.