Results 1 to 2 of 2
  1. #1
    New Lounger
    Join Date
    Jul 2014
    Posts
    1
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Copy & insert rows fom one sheet to another based on data in main sheet

    Hi all,
    I have been trying to solve this problem but canít seem to. I would be grateful if one of you awesome excel users would be able to help.
    I have attached a sample sheet below.
    I have one main sheet called Project Details where I want to input all data.
    In the sub-sheets i.e (Jhon, Adam, Josh,Katy..etc) I only input the headers.
    I want to create a macro so that in the main sheet (Project Details) any Column from C to F that shows Jhonís name, that whole row will be moved into Jhonís sheet.
    For example, Row 7 shows Jhons name is cell C7 so I want the whole of row 7 from (A to O) to copy into Jhons sheet using the macro.
    Similarly, Row 8 shows Jhons name is cell D8 so I want the whole of row 8 from (A to O) to copied into Jhons sheet
    Since Jhons name isnít in row 10, that row will not be moved into Jhons sheet.
    I hope that makes sense and one of you will be able to assist me.
    I am new to VBA, I created a macro but canít seem to make it work.
    All your help will be truly appreciated.
    Regards,
    VMAL
    Attached Files Attached Files

  2. #2
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,538
    Thanks
    3
    Thanked 148 Times in 141 Posts
    Try the following. Your input sheet was not well organised (in terms of column titles and used range) so I explictly named the address of the region where the names can be found. You will need to modify this if your names list grows or shrinks. I set my code to add the named sheets and it will fail if you already have sheets with those names. Finally, you will need to add a reference to "Microsoft Scripting Runtime" under Tools > References

    Code:
    Sub MakeSheets()
      Dim d As Object, rng As Range, k, tmp As String
      Dim aSht As Worksheet, sAdd As String
      Dim iRows As Integer, cFound As Range
      
      sAdd = "C7:F11"
      
      Set d = CreateObject("scripting.dictionary")
      For Each rng In ActiveWorkbook.Sheets("Project Details").Range(sAdd)
        tmp = Trim(rng.Value)
        If Len(tmp) > 0 Then d(tmp) = d(tmp) + 1
      Next rng
      
      For Each k In d.Keys
        Debug.Print k, d(k)
        Sheets("Project Details").Copy after:=Sheets(Sheets.Count)
        Set aSht = ActiveSheet
        aSht.name = k
        With aSht
          Set rng = aSht.Range(sAdd)
          For iRows = rng.Rows.Count To 1 Step -1
            Set cFound = rng.Rows(iRows).Find(k, LookIn:=xlValues)
            If cFound Is Nothing Then rng.Rows(iRows).EntireRow.Delete
          Next iRows
        End With
      Next k
    End Sub
    Andrew Lockton, Chrysalis Design, Melbourne Australia

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •