I have a spreadsheet with 1000+ rows. Trying to copy the data matching in one of the columns "H" to sheet which is also given the name from H. But would like to also sort data such that values in column "H" that match"comp-harb"; "comp-harb-active"; comp-harb-exp" all get copied to a single worksheet labelled speficically as "comp-harb". I was able to lookup answers to find a code which I was able to use. But it separates the "comp*" into separate worksheets. Is there a way to specify to copy them into one worksheet? Any help is greatly appreciated.
Option Explicit
Sub CopyRows()
Dim rngMyRange As Range, rngCell As Range
Dim sht As Worksheet
Dim LastRow As Long
Dim SheetName As String
Dim Cell As Range
Dim bk As Workbook
Set bk = Application.ActiveWorkbook
Application.ScreenUpdating = False
With Sheets("combined")
Set rngMyRange = .Range(.Range("H2"), .Range("H65536").End(xlUp))
For Each rngCell In rngMyRange
rngCell.EntireRow.Select
Selection.Copy
If rngCell Like "comp-harb*" Then GoTo Line1 Else GoTo Line2
Line1:
If WorksheetExists("comp-harb") Then
SheetName = "comp-harb"
Sheets(SheetName).Select
Set sht = ActiveWorkbook.Worksheets(SheetName)
LastRow = sht.Cells(sht.Rows.Count, "H").End(xlUp).Row
Rows(LastRow + 1).Select
Selection.Insert Shift:=xlDown
Else: Sheets.Add After:=ActiveSheet
Rows("1:1").Select
Selection.Insert Shift:=xlDown
ActiveSheet.Name = "comp-harb"
GoTo Lastline
End If
Line2:
If WorksheetExists(rngCell.Value) Then
SheetName = rngCell.Value
Sheets(SheetName).Select
Set sht = ActiveWorkbook.Worksheets(SheetName)
LastRow = sht.Cells(sht.Rows.Count, "H").End(xlUp).Row
Rows(LastRow + 1).Select
Selection.Insert Shift:=xlDown
Else: Sheets.Add After:=ActiveSheet
Rows("1:1").Select
Selection.Insert Shift:=xlDown
ActiveSheet.Name = rngCell.Value
End If
GoTo Lastline
'Go back to the DATA sheet
Lastline:
Sheets("combined").Select
Next
End With
End Sub
Function WorksheetExists(sName As String) As Boolean
WorksheetExists = Evaluate("ISREF('" & sName & "'!H1)")
End Function