Macro for Data Mining

  • Thread starter Thread starter MLewis123
  • Start date Start date
M

MLewis123

Ok, I will make this question as easy as possibly.

I have some data from a survey that was done.

I have compiled it in the following manner:
A1 = Client Name; B2 = Comment 1; C3 = Comment 2, ect up to 13.

Now, I have created a sample template in a worksheet that I want each
clients data to show up there automatically. I have figured out the macro to
bring new tabs into the workbook based on how many clients, but I cannot
figure out how to bring the data from the survey to each respective
worksheet. This is the macro to automatically add the sheets.

Sub Create_Client_Sheets()
Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("Client Info").Range("a2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))
For Each MyCell In MyRange
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyCell.Value
Next MyCell
End Sub

So in essence here is what I want:
When I run the macro each client will have their own worksheet with their
survey data in it, the reason for seperate workbooks is we will review the
data with each client.

Hope this is enough information.
Thanks in advance for the help.
 
A1 = Client Name; B2 = Comment 1; C3 = Comment 2, ect up to 13

Are you sure this is staggered like that, or is it more like:

A1 = Client Name; B 1= Comment 1; C1 = Comment 2, ect up to M1 for each
client?
 
Yes, you are correct!! Sorry!!

JLGWhiz said:
A1 = Client Name; B2 = Comment 1; C3 = Comment 2, ect up to 13

Are you sure this is staggered like that, or is it more like:

A1 = Client Name; B 1= Comment 1; C1 = Comment 2, ect up to M1 for each
client?
Click to expand...
 
This might work:

Sub dk()
Dim sh As Worksheet, rng As Range, lr As Long
lr = Sheets("Client info").Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Sheets("Client info").Range("A2:A" & lr)

For Each Sh In Thisworkbook.Sheets
If sh.Name <> "Client infor
Set c = rng.Find(sh.Name, LookIn:=xlValues)
If Not c Is Nothing Then
c.EntireRow.Copy sh.Range("A2")
End If
End If
Next
End Sub
 
Hmmm....did not work. I posted another question, I am going to try to back
into it differently.
 
Could be the typo that caused the problem:


For Each Sh In Thisworkbook.Sheets
If sh.Name <> "Client info"
Set c = rng.Find(sh.Name, LookIn:=xlValues)
If Not c Is Nothing Then
c.EntireRow.Copy sh.Range("A2")
End If
End If
Next
End Sub

Also, it could be that the sheet name has the file extension included in one
place but not the other, which would invalidate the Find criteria.
 
Disregard the note about file extension. I had workbooks on my mind.
Should not affect the sheet name.
 
Back
Top