VBA- Macro to move entire row of data to new sheet, based on a cell value

[Garrek]

Good morning all,

I'm looking to make a macro to move a full row (columns A-M) from one sheet to another, based on a value in column A. In the first sheet (Sheet1), Column A is populated entirely with unique values. My hope is that the macro could read a cell (B14) containing one of these values on a different sheet (Sheet3), then look up that value, copy the entire row that it is, and paste it onto the target sheet (Sheet2).

Could anyone provide help on this? Let me know if you have any clarifying questions.

 

[SupremeDr]

Good morning all,

I'm looking to make a macro to move a full row (columns A-M) from one sheet to another, based on a value in column A. In the first sheet (Sheet1), Column A is populated entirely with unique values. My hope is that the macro could read a cell (B14) containing one of these values on a different sheet (Sheet3), then look up that value, copy the entire row that it is, and paste it onto the target sheet (Sheet2).

Could anyone provide help on this? Let me know if you have any clarifying questions.

Hi Garrek, I might need some more information but seems like this might get you started

Dim i as string
i = inputbox(addvaluehere) 'this isn't neccessary. You can build a hard value into the code if it's always the same. 

If Sheets("Sheet3").Range("B14").Value = i then
    Sheets("Sheet1").Columns("A:M").Copy
    Sheets("Sheet2").Select
    Activesheet.Paste
End if

Not sure if this is what you need, feel free to give more info

 

[Garrek]

Hi Garrek, I might need some more information but seems like this might get you started

Dim i as string
i = inputbox(addvaluehere) 'this isn't neccessary. You can build a hard value into the code if it's always the same. 

If Sheets("Sheet3").Range("B14").Value = i then
    Sheets("Sheet1").Columns("A:M").Copy
    Sheets("Sheet2").Select
    Activesheet.Paste
End if

Not sure if this is what you need, feel free to give more info[/QUOTE]


Thanks for the reply! This doesn't seem to be working for me at the moment however. Essentially my goal is for the User to input a value (2 letter code, actually) into cell B14 on Sheet 3. After inputting that value, the macro will find it in column A of Sheet 1, copy the entire row (A-M) of said value (i.e. if the value is found at A44, it will copy A44-M44) and paste it at the bottom of the table found on Sheet 2. 

Does that clear it up? If it helps, Sheet 1 contains active objects and some data on them, Sheet 2 is inactive ones. So this will be used to "retire" the active ones to the inactive sheet.

 

[Fluff]

How about

Sub Garrek()
   Dim Fnd As Range
   
   With Sheets("Sheet1")
      Set Fnd = .Range("A:A").Find(Sheets("Sheet3").Range("B14").Value, , , xlWhole, , , False, , False)
   End With
   If Not Fnd Is Nothing Then
      Fnd.Resize(, 13).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
   Else
      MsgBox "nothing found"
   End If
End Sub

 

[SupremeDr]

Thanks for the reply! This doesn't seem to be working for me at the moment however. Essentially my goal is for the User to input a value (2 letter code, actually) into cell B14 on Sheet 3. After inputting that value, the macro will find it in column A of Sheet 1, copy the entire row (A-M) of said value (i.e. if the value is found at A44, it will copy A44-M44) and paste it at the bottom of the table found on Sheet 2.

Does that clear it up? If it helps, Sheet 1 contains active objects and some data on them, Sheet 2 is inactive ones. So this will be used to "retire" the active ones to the inactive sheet.

Dim table1 as range, rowcount as long, firstrow as long
Set table1 = Sheets("Sheet1").Range("A1").CurrentRegion
rowcount = table1.rows.count
firstrow = table1.rows(1).count
Dim i as long

For i = firstrow to rowcount
if cells(i, 1) = Sheets("Sheet3").Range("B14").Value then
rows(i).copy
Sheets("Sheet2").Select
Range("A1").Select
Activesheet.Paste
Sheets("Sheet1").Select
End if
next

If you are always adding to sheet 2 and the list is getting long you will have to add a dim to recognize the table on sheet2 and add to the bottom

 

[Garrek]

How about

Sub Garrek()
   Dim Fnd As Range
   
   With Sheets("Sheet1")
      Set Fnd = .Range("A:A").Find(Sheets("Sheet3").Range("B14").Value, , , xlWhole, , , False, , False)
   End With
   If Not Fnd Is Nothing Then
      Fnd.Resize(, 13).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
   Else
      MsgBox "nothing found"
   End If
End Sub

This works beautifully! Would it be possible to delete the row that is copied to the new sheet?

 

[Fluff]

Yup, just add the line in blue

Sub Garrek()
   Dim Fnd As Range
   
   With Sheets("Sheet1")
      Set Fnd = .Range("A:A").Find(Sheets("Sheet3").Range("B14").Value, , , xlWhole, , , False, , False)
   End With
   If Not Fnd Is Nothing Then
      Fnd.Resize(, 13).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
     [COLOR=#0000ff] Fnd.EntireRow.Delete[/COLOR]
   Else
      MsgBox "nothing found"
   End If
End Sub

 

[Garrek]

Yup, just add the line in blue

Sub Garrek()
   Dim Fnd As Range
   
   With Sheets("Sheet1")
      Set Fnd = .Range("A:A").Find(Sheets("Sheet3").Range("B14").Value, , , xlWhole, , , False, , False)
   End With
   If Not Fnd Is Nothing Then
      Fnd.Resize(, 13).Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
     [COLOR=#0000ff] Fnd.EntireRow.Delete[/COLOR]
   Else
      MsgBox "nothing found"
   End If
End Sub

One final thing I thought of (I apologize for the additions, I think this should be the last!) Currently on Sheet1, all entries have "Active" in column C. How could I make it so when entries are moved from Sheet1 to Sheet2, Column C changes from "Active" to "Inactive/Retired"?

 

[Fluff]

How about

   If Not Fnd Is Nothing Then
      With Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)
         Fnd.Resize(, 13).Copy .Offset(1)
         .Offset(1, 2).Value = "Inactive"
         Fnd.EntireRow.Delete
      End With
   Else
      MsgBox "nothing found"
   End If

 

[Garrek]

How about

   If Not Fnd Is Nothing Then
      With Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)
         Fnd.Resize(, 13).Copy .Offset(1)
         .Offset(1, 2).Value = "Inactive"
         Fnd.EntireRow.Delete
      End With
   Else
      MsgBox "nothing found"
   End If

Would the full code look like this then?

 Sub RetireMove()   Dim Fnd As Range
   
   With Sheets("Sheet1")
      Set Fnd = .Range("A:A").Find(Sheets("Sheet3").Range("B14").Value, , , xlWhole, , , False, , False)
   If Not Fnd Is Nothing Then
      With Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)
         Fnd.Resize(, 13).Copy .Offset(1)
         .Offset(1, 2).Value = "Inactive"
         Fnd.EntireRow.Delete
      End With
   Else
      MsgBox "nothing found"
   End If
End Sub

It doesn't seem to be working for me, although I'm not sure if I properly inputted that last bit.