0

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
Martijn Pieters
  • 1,048,767
  • 296
  • 4,058
  • 3,343
thekid
  • 1
  • 2
  • `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".` Have you seen [THIS?](https://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s/11633207#11633207) – Siddharth Rout Aug 22 '18 at 04:05
  • Thank you will try this and see if it works. Would you be able to assist me in combining the codes. – thekid Aug 22 '18 at 04:10
  • 1
    Sure but I would like you to try it first. If you get stuck then post the code that you came up with. If I see serious efforts from your side then yes I will help you :) – Siddharth Rout Aug 22 '18 at 04:14
  • Well, at the end I had to use GoTo to get around things :( – thekid Aug 22 '18 at 08:26
  • This whole script works with a worksheet called "combined". But I would like to open an existing workbook and run the macro to allow me to select the "combined" file and parse the data from the "combined" workbook to my current workbook using the above code. – thekid Aug 22 '18 at 09:02

0 Answers0