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

    Copy Rows to new sheet with TWO header rows [SOLVED]

    Hi,

    First off, I'm a VBA noob. I'm trying to have a script look at a column, create new spreadsheets off of the unique values in that column, and then copy the data over into the correct worksheet. For example, I have a list of all employees worldwide and I want to have new sheets created for each country they are in and then the data from the Master Data Sheet to the corresponding country the employee resides in. I found some code on this site to do mostly all that I need, with just a problem or two.

    First: I have 2 header rows (1 is essentially just a "GRAND TOTALS" row which I guess I would be fine with adding at the end, but don't really know how to do that either, and the other is the actual header data, i.e. country, name, etc). As of now, I can only get it to copy the GRAND TOTALS row (Row 1), but I really need it to copy Rows 1 and 2 to each sheet..

    Second: I appears that it is actually copying data onto the master Data Sheet as well, when I want that data to remain intact and just be used to copy, if possible. The only reason I know it is changing the data is because it is overriding my second header row on the master sheet.

    Below is the code. Any help would be greatly appreciated. Oh, FYI, the GRAND TOTALS technically starts at K1, and the data label headers starts at A2 if that makes any difference.

    Code:
    Sub CopyData()
    Dim I As Long, lFirst As Long, lLastRow As Long
    Dim strName As String
    Dim oWS As Worksheet
    lLastRow = Worksheets("Master Data Sheet").UsedRange.Rows.Count
    Worksheets("Master Data Sheet").Range("A1:IV" & lLastRow).Sort Key1:=Worksheets("Master Data Sheet").Columns("A"), _
    Order1:=xlAscending, Header:=xlYes
    lFirst = 1
    Do While Worksheets("Master Data Sheet").Range("A1").Offset(lFirst, 0).Value <> ""
    strName = Worksheets("Master Data Sheet").Range("A1").Offset(lFirst, 0).Value
    For I = lFirst To lLastRow
    If strName <> Worksheets("Master Data Sheet").Range("A1").Offset(I + 1, 0).Value Then Exit For
    Next I
    Set oWS = Nothing
    On Error Resume Next
    Set oWS = Worksheets(strName)
    On Error GoTo 0
    If oWS Is Nothing Then
    Set oWS = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    oWS.Name = strName
    End If
    oWS.Cells.ClearContents
    Worksheets("Master Data Sheet").Range("1:1").Copy Destination:=oWS.Range("A1")
    Worksheets("Master Data Sheet").Range("A" & lFirst + 1 & " :A" & I + 1).EntireRow.Copy Destination:=oWS.Range("A2")
    lFirst = I + 1
    Loop
    End Sub
    Thanks!
    Last edited by RetiredGeek; 2014-07-15 at 15:35. Reason: Marked Solved

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,414
    Thanks
    208
    Thanked 836 Times in 769 Posts
    Sdizzle,

    Welcome to the Lounge as a new poster!

    Could you post a sample master sheet so we can visualize what is necessary?
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  3. #3
    New Lounger
    Join Date
    Jul 2014
    Posts
    6
    Thanks
    1
    Thanked 0 Times in 0 Posts
    RetiredGeek,

    Thanks for your assistance. Attached is a copy of what I have. Running the macro should also show you the issues I'm having.
    Attached Files Attached Files

  4. #4
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,414
    Thanks
    208
    Thanked 836 Times in 769 Posts
    Sdizzle,

    I hope you don't mind but I started from scratch as I was having trouble following the existing code. This works if I understand your requirements correctly.
    Code:
    Option Explicit
    
    Sub CopyData()
    
       Dim lRowCntr      As Long
       Dim lLastRow      As Long
       Dim lCtryLastRow  As Long
       Dim rngTitles     As Range
       Dim zShtName      As String
       Dim wksMaster     As Worksheet
       Dim wksCountrySht As Worksheet
       
    '*** Initialize working parameters ***
    
       Sheets("Master Data sheet").Activate
       Set wksMaster = ActiveSheet
       lLastRow = Cells(Rows().Count, 1).End(xlUp).Row()
       Set rngTitles = Range("A1:Y2")
       
    '*** Main Processing Loop ***
    
       For lRowCntr = 3 To lLastRow
          zShtName = Cells(lRowCntr, 1)
          On Error GoTo SheetErrorTrap
            Set wksCountrySht = Sheets(zShtName)
          On Error GoTo 0
          lCtryLastRow = wksCountrySht.Cells(Rows().Count, 1).End(xlUp).Row() + 1
          wksMaster.Range(Cells(lRowCntr, 1), Cells(lRowCntr, 25)).Copy Destination:=wksCountrySht.Cells(lCtryLastRow, 1)
       Next lRowCntr
    
    '*** End Main Processing Loop ***
       GoTo MainProcessExit
       
    SheetErrorTrap:  '*** Catch Non-Existent Sheet and Add sheet & headers ***
    
       If Err = 9 Then
         Set wksCountrySht = Worksheets.Add(After:=Worksheets(Worksheets.Count))
         wksCountrySht.Name = zShtName
         rngTitles.Copy Destination:=wksCountrySht.[A1]
         wksMaster.Activate
       End If
       
       Resume Next
    
    MainProcessExit:
    
    End Sub   'CopyData
    dsizzle.JPG

    HTH
    Attached Files Attached Files
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  5. #5
    New Lounger
    Join Date
    Jul 2014
    Posts
    6
    Thanks
    1
    Thanked 0 Times in 0 Posts
    You, sir, are a gentleman and a scholar. Many thanks! It worked perfectly to my needs!

Posting Permissions

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