My requirements are simple. I have a huge worksheet with hundreds of rows and columns. I need to search a string or a part-of-the string, copy all rows which contain that part-of-string to a new worksheet and name the worksheet as the name of the string or sub-string.
I tried the following code:
Sub try()
Dim strLastRow As String
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim MySheetName As String
Dim wSht As Worksheet
Dim wSht1 As Worksheet
Dim rngtest As String
Application.ScreenUpdating = False
strToFind = InputBox("Enter the STring to find")
Set wSht = Worksheets("Sheet2")
With ActiveSheet.Range("B1:B2000")
Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
strLastRow = Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1
rngC.EntireRow.Copy wSht.Cells(strLastRow, 1)
Set rngC = .FindNext(rngC)
Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
End If
End With
On Error Resume Next
MySheetName = strToFind
Worksheets(MySheetName).Delete
Err.Clear
Application.DisplayAlerts = True
Worksheets.Add.Name = MySheetName
Sheets("Sheet2").Range("A1:B2000").Copy
Sheets(MySheetName).Activate
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Sheet2").Cells.ClearContents
MsgBox ("Finished")
End Sub
The code works in excel 2010 but does not work in 2007. And it does not work for parts of string.
My columns are like this_midas_2050, that_midas_2040 etc.
I need to seach for midas in the worksheet and create a worksheet named midas.
Thanks a lot in advance
Bookmarks