VBA Macro To Find Specific Text And Insert Text Few Rows Below
I have a workbook with several sheets and want to find "DEPR-GENERATORS" in Col B and insert "DEPR in front on the text from one row below to 5 rows below
This must exclude sheets "Data", "Accounts", "TB"
The macro is only affecting the active sheet
When running the macro the text is inserted for eg DEPRDEPRDEPRDEPRDEPRDEPRDEPRDEPRDEPRDEPRDEPR-COMPUTER EQUIP
See Sample data
Code:
Sub find_Dep()
Dim Sh As Worksheet
Dim lr As Long
For Each Sh In ActiveWorkbook.Worksheets
Select Case Sh.Name
Case "Data", "Accounts", "TB"
Case Else
With Sh
lr = .Cells(.Rows.Count, "B").End(xlUp).Row
Cells.Find(What:="DEPR-GENERATORS", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
'.Range("B1:B" & lr).Resize(5).Replace What:=" ", Replacement:="DEPR", LookAt:=xlPart
For i = 1 To 5
ActiveCell.Offset(i, 1) = "DEPR" & Trim(ActiveCell.Offset(i))
Next
End With
End Select
Next Sh
End Sub
Your assistance in correcting the code is much appreciated
