• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 72
  • Last Modified:

Move data to new sheets

In Sheet1 column 'P' there are country names. [i.e. Spain, France,United States, Canada etc.etc.] this has been sorted in order A-Z

I need to copy the entire row for each group of names [including the header] on to a new tab so that each tab contain the header and just the one country.

would appreciate an expert providing me with the VBA code to do this please
0
Jagwarman
Asked:
Jagwarman
  • 3
  • 2
  • 2
  • +1
1 Solution
 
FarWestCommented:
please provide a sample sheet
0
 
Saqib Husain, SyedEngineerCommented:
Try this macro

Sub c2sheets()
    Dim cel As Range
    Dim sws As Worksheet
    Dim tws As Worksheet
    Set sws = ActiveSheet
    For Each cel In Range("P2:P" & Range("P" & Rows.Count).End(xlUp).Row)
        If cel.Value <> "" Then
            Set tws = Worksheets.Add(, Worksheets(Worksheets.Count))
            tws.Name = cel.Value
            sws.Range("1:1").Copy tws.Range("1:1")
            cel.EntireRow.Copy tws.Range("2:2")
        End If
    Next cel
End Sub
0
 
JagwarmanAuthor Commented:
Hi Saqib Husain, Syed

not quite. What it is trying to do is put each row from sheet 1 onto a new sheet and rename that sheet with the name in column P [i.e. Spain]

So if there are 4 rows in Sheet1 with the name Spain in row P it is trying to name every sheet Spain and each sheet would contain only the header and one row.

What I need it to do is; if there are 4 rows with data for Spain put all 4 rows on that new tab then do same for France, Canada etc.

Thanks
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
FarWestCommented:
Thats why I asked for a sample sheet
is there a problem to upload it
0
 
JagwarmanAuthor Commented:
File attached
copy-to-new-sheets.xlsx
0
 
Rgonzo1971Commented:
Hi,

pls try

Sub c2sheets()
Set SrcSheet = ActiveSheet
For Idx = 2 To Range("M2:M" & Range("M" & Rows.Count).End(xlUp).Row).Count + 1
    If SrcSheet.Range("M" & Idx).Value <> "" Then
        Set DestSh = Worksheets.Add(, Worksheets(Worksheets.Count))
        DestSh.Name = SrcSheet.Range("M" & Idx).Value
        Idx2 = Idx
        While SrcSheet.Range("M" & Idx).Offset(1) = SrcSheet.Range("M" & Idx)
            Idx = Idx + 1
        Wend
        SrcSheet.Range("1:1").Copy DestSh.Range("1:1")
        SrcSheet.Range(Idx & ":" & Idx2).Copy DestSh.Range("2:2")

    End If
Next
End Sub

Open in new window

Regards
0
 
JagwarmanAuthor Commented:
perfect Rgonzo thanks
0
 
Saqib Husain, SyedEngineerCommented:
The question says country name in P whereas example shows country name in M

Sub c2sheets()
    Dim cel As Range
    Dim sws As Worksheet
    Dim tws As Worksheet
    Set sws = ActiveSheet
    Application.DisplayAlerts = False
    For Each cel In Range("M2:M" & Range("M" & Rows.Count).End(xlUp).Row)
        If cel.Value <> "" Then
            Set tws = Worksheets.Add(, Worksheets(Worksheets.Count))
            On Error Resume Next
            tws.Name = cel.Value
            If Err Then tws.Delete
            On Error GoTo 0
            Set tws = Sheets(cel.Value)
              sws.Range("1:1").Copy tws.Range("1:1")
            cel.EntireRow.Copy Cells(tws.UsedRange.Rows.Count + 1, 1)
        End If
    Next cel
End Sub

Open in new window

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 3
  • 2
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now