Copy numbers from an array, each to it’s own sheet

R

ryguy7272

I’m trying to figure out a way to loop through a list (now the range is
A1:E10, but it will change) and copy/paste each unique set of numbers into
it’s own sheet. For instance, I want to put all 1s in ColumnA on Sheet named
‘1’, all 2s in ColumnA on sheet named ‘2’, etc. I have numbers 1-7 in my
range now (so I want to dynamically create 7 sheets), but this will change.

This is the code I am working with now:
Sub CopyNums()
Dim c As Range
Dim d As Range
Dim FirstAddress As String
Dim myFindString As String
Dim NewSht As Worksheet

myFindString = "1"
With ActiveSheet.Range("A:E")
Set c = .Find(myFindString, LookIn:=xlValues, LookAt:=xlWhole)

If Not c Is Nothing Then
Set d = c
FirstAddress = c.Address
End If

Selection.Copy

Set c = .FindNext(c)
If Not c Is Nothing And c.Address <> FirstAddress Then
Do
Set d = Union(d, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If

'Add a worksheet
'Set NewSht = ActiveWorkbook.Worksheets.Add
'NewSht.Name = myFindString

Range("G1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Range("A1").Select


End With
d.Select
End Sub

That takes all the 1s and put them in G1 (of the same sheet, but this is not
what I want to do). So, it doesn't let me do what I want to do, and in fact,
it only works sometimes. Ugh! I guess the Union operator is getting screwed
up. Any suggestions as to how I can make this work?

Thanks,
Ryan---
 
R

ryguy7272

Thanks Ron! Very clever! I've used your code many times in the past.
Thanks so much! This time the data is organized differently; the code you
suggested won't work for me in this instance. Here's a sample of my data:

1 2 1 1 2
2 3 2 2 1
1 2 1 1 2
3 4 3 3 4
1 2 1 1 2
4 5 4 4 5

So, I'd like a sheet named 1, with the value 1 in A1:A10. Then, I'd like a
sheet named 2, with the value 2 in A1:A8. Then, I'd like a sheet named 3,
with the value 3 in A1:A4. Does it make sense? I'm going to keep working on
it, but I don't think I'm very close to a solution.

Thanks!
Ryan--
 
M

Mike H

Why not just count them

Sub sonic()
Set sht = Sheets("Sheet1")
Dim x As Long
Dim NumNum As Long
For x = 1 To WorksheetFunction.Max(sht.Range("A1:E10"))
NumNum = WorksheetFunction.CountIf(sht.Range("A1:E10"), x)
If NumNum > 0 Then
Worksheets.Add().Name = CStr(x)
Range("A1:A" & NumNum) = x
NumNum = 0
End If
Next
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top