Copying specific cells to a new sheets also give sheetname

[elmnas]

Hi guys,

I have a function that loops through all the sheets in a excel document
I return the name of the sheets,

See code below:

Sub WorksheetLoop()

Dim WS_Count As Integer
Dim I As Integer


WS_Count = ActiveWorkbook.Worksheets.Count


' Begin the loop.
For I = 1 To WS_Count


' Insert your code here.
'MsgBox ActiveWorkbook.Worksheets(I).Name

Next



Now I need a function

my exceldocument contain over 30 different columns "CAT", "DOG", "BIRD" ,"HORSE" etc.


I need a script that check after a certain cell-color (Blue, RGB 0,112,192)


when it finds the first blue cell,

the script copying the blue cell + the first word in the same column, the word is always on row 1, also copying the word in column B in the same row to the same place but in a new sheet,
the script also copying cell from the same column it finds the blue cell on, the first row cell and give it as name on the sheet it creats


so example see pictures



this is a orginal excel document

12909

example result 1

12908
example result 2

12907

Could someone help me out ?

Thank you in advance

[Yongle]

Try this - it should do everything you need.
I have not tried it inside your code - that is your job.
Suggest you test this as a standalone macro and then try inserting it in your procedure.
Yon
Sub Find_Coloured_Cell()
'set variables
Dim ColTitle As String, RowTitle As String
Dim LastCol As Long, lastRow As Long
'find last row and last columns
Sheets("Sheet1").Select
Range("C1").Select
Selection.End(xlToRight).Select
LastCol = ActiveCell.Column
Range("B2").Select
Selection.End(xlDown).Select
lastRow = ActiveCell.Row
'loop through alll columns and cells looking for first blue cell in each column _
create new sheet, name it with relevant column header, copy cell colour etc to _
new sheet
For c = 3 To LastCol
'check if worksheet exists - may have already created it previously
ColTitle = Cells(1, c).Value
For i = 1 To Worksheets.Count
If Worksheets(i).Name = ColTitle Then
exists = True
i = 1
GoTo NextColumn
End If
Next i

For r = 2 To lastRow
If Cells(r, c).Interior.Color = RGB(0, 112, 192) Then
ColTitle = Cells(1, c).Value
RowTitle = Cells(r, 2).Value
Sheets.Add.Name = ColTitle
Sheets(ColTitle).Select
Cells(r, c).Interior.Color = RGB(0, 112, 192)
Cells(1, c).Value = ColTitle
Cells(r, 2).Value = RowTitle
r = 12
Else: End If
Sheets("Sheet1").Select
Next r
NextColumn:
Next c
End Sub

[elmnas]

Awesome thanks man that helped me I have modified it a bit,

I got still a little problem.


You have declared sheet as Sheet1,

the problem is it have to loop through all sheets,

I dont make it work with my loop and then combine your code,


Here is my code:




Sub Langauge_Combination()


For Each sht In ActiveWorkbook.Worksheets
Set Rng = sht.UsedRange


Set MyRange = Rng
For Each MyCol In MyRange.Columns
For Each MyCell In MyCol.Cells
'MsgBox ("Address: " & MyCell.Address & Chr(10) & "Value: " & MyCell.Value)


If MyCell.Interior.ColorIndex = 23 Then




MsgBox "Language is: " & MyCol.Cells(1, 1).Text




'MsgBox "" & Mycell.Column


'Cells(Mycell.Row, 2).Copy
'Mycell.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
'SkipBlanks:=False, Transpose:=False




End If
Next
Next
Next


End Sub






Could you help me out?

Thank you in advance

[Yongle]

Where does it break down?
What does not work?

Yon

[elmnas]

Where does it break down?
What does not work?

Yon


You have assigned in your code a specific sheets it start on "Sheet1"

[Yongle]

Hi
Just in case I have misunderstood what you wrote. (all this from post #1)
1 At the beginning your workbook contains one sheet (Sheet1)
2 Sheet1 has a several columns that you want to search and FIND the first blue cell (commencing at column C)
3 When you find the first blue cell , CREATE a new sheet and give it a name = value in row1 for that column
4 Now COPY 3 things to new sheet (blue cell position, value in column B and value in row1 )
5 At the end your workbook contains Sheet1 plus 30+ newly created sheets(each containing 2 cells with text and one blue cell
Question 1 - is this all correct?

In post#1 is a worksheet with "Sheet1" containing the data that you said you wanted to use to create new worksheets (and also to copy certain cells from to your new worksheets).
Question 2 - where in your code (in post #3) are you creating the new sheets?


thanks

[elmnas]

See Images for orginal and the whole process

here is the orginal it
12929

the thing is the document contains already loads sheets with different names,
and the script need to loop through all the sheets and do the same.
this is the first blue cell.
12930
here is the third tab it creates and so on..

12931

The important is,
the script have to loop through all sheets in the document. (and find the blue cells and soo on)

[Yongle]

You have not said anything different to what was in Post#1 and you have not answered my questions.
I am happy to help you, but if you want some help, I must understand what you are trying to do, and you need to answer the questions I asked you in previous post. Please no screen prints, just answers.

From Post#1 my understanding is that
1 At the beginning your workbook contains one sheet (Sheet1)
2 Sheet1 has a several columns that you want to search and FIND the first blue cell (commencing at column C)
3 When you find the first blue cell , CREATE a new sheet and give it a name = value in row1 for that column
4 Now COPY 3 things to new sheet (blue cell position, value in column B and value in row1 )
5 At the end your workbook contains Sheet1 plus 30+ newly created sheets(each containing 2 cells with text and one blue cell
Question 1 - is this all correct? if not correct please explain what is incorrect

In Post#1 you included screenprint of worksheet with "Sheet1" containing the data that you said you wanted to use to create new worksheets (and also to copy certain cells from to your new worksheets).
Question 2 - where in your code (in Post #3) are you creating the new sheets?

In post# you did not say that there are "loads of sheets", you said that the code was going to create new sheets.
Question 3 - Before doing anything, does your sheet contain "loads of sheets" or just one sheet

I provided you with code that would achieve exactly what you wanted, based on what you wrote in Post#1. I am happy to help you further, but if you want some help, I must understand exactly what you are trying to do, and to do that you need to answer those 3 questions.