Need to copy a part of row based on a "specific text" to another sheet

[Rajeshwari]

Hello Everyone, I am new to the concept of macros. I need a code to copy a part of a row based on specific texts into another sheet. Example, From Sheet1(current sheet), I need to copy the range from A to H of all rows containing the words either "Free" or "Re purposed" into sheet 2 from range B2. Where, the previous contents of sheet2 has to be deleted except row1. Kindly help me.Not sure where to start of end, my codes are big mess.

 

[Rick Rothstein]

Hello Everyone, I am new to the concept of macros. I need a code to copy a part of a row based on specific texts into another sheet. Example, From Sheet1(current sheet), I need to copy the range from A to H of all rows containing the words either "Free" or "Re purposed" into sheet 2 from range B2. Where, the previous contents of sheet2 has to be deleted except row1. Kindly help me.Not sure where to start of end, my codes are big mess.

Can the words "Free" or "Re purpose" be anywhere on the sheet or are they confined to a single column (if so, which one)?

 

[Rajeshwari]

sorry for not to being clear.. its confined to single column .. column "A"

 

[Rajeshwari]

can someone help in this .. Please...

 

[Rajeshwari]

I somehow managed to code.. but something is wrong in the below, no rows are copied...its working only till filters are enabled

Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws1 As Worksheet
Set ws1 = Worksheets("Sheet3")


iRow = ws1.Cells.Find(What:="*", _
SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, _
LookIn:=xlValues).Row + 1


ws1.Rows("2:" & Rows.Count).ClearContents


With Sheet2

.AutoFilterMode = False
With .Range("A1:H1")
.AutoFilter
.AutoFilter Field:=1, Criteria1:="Free Slot"
.AutoFilter Field:=1, Criteria2:="To be Repurposed"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Copy
ws1.Range("B" & iRow).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, False, False
End With

For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
ws1.Cells(i, "A").Value = i - 1
Next i


MsgBox "Record has been Updated!", , "Record Updated"
End With


End Sub

 

[Rick Rothstein]

See if this macro does what you want (you might want to try it out on a copy of your workbook in case not)...

Sub MoveFreeSlotAndToBeRepurposed()
  Dim LastRow As Long, Rng As Variant
  LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
  Sheets("Sheet1").Range("A1:H" & LastRow).Copy Sheets("Sheet2").Range("A1")
  With Sheets("Sheet2").Range("A2:A" & LastRow)
    .Value = Evaluate(Replace("IF(Sheet1!A2:A#=""Free Slot"",Sheet1!A2:A#,"""")", "#", LastRow))
    .Value = Evaluate(Replace("IF(Sheet1!A2:A#=""To be Repurposed"",""To be Repurposed"",Sheet2!A2:A#)", "#", LastRow))
    .SpecialCells(xlConstants, xlNumbers).EntireRow.Delete
  End With
  Sheets("Sheet1").Range("A2:H" & LastRow).Clear
End Sub