elmnas
03-02-2015, 04:11 AM
Hi guys
I have following code to find a certain cell that give all the sheets a the certain cell name
but instead of sheets I need workbooks
COuld someone help me to correct the code
instead of sheets I make workbooks with the certain cell name
also if you know how to copy all the data from the sheets it loops through, to the new workbooks
See code below:
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
sht.Cells(MyCell.Row, MyRange.Columns(2).Column).Copy
'MsgBox "Language is: " & MyCol.Cells(1, 1).Text
Dim objSheet As Worksheet
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Name = MyCol.Cells(1, 1).Text Then
End 'MsgBox "A worksheet with that name already exists."
Worksheets(MyCol.Cells(1, 1).Text).Activate
End If
Next objSheet
Worksheets.Add ' I ADD HERE WORKSHEETS,
WorkBook.add ' HERE IS A EXAMPLE OF HOW I ADD A WORKBOOK
' MsgBox "hej"
ActiveSheet.Name = MyCol.Cells(1, 1).Text ' HERE I GIVE THE NAME OF THE WORKSHEET.
End If
Next
Next
Next
End Sub
I have following code to find a certain cell that give all the sheets a the certain cell name
but instead of sheets I need workbooks
COuld someone help me to correct the code
instead of sheets I make workbooks with the certain cell name
also if you know how to copy all the data from the sheets it loops through, to the new workbooks
See code below:
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
sht.Cells(MyCell.Row, MyRange.Columns(2).Column).Copy
'MsgBox "Language is: " & MyCol.Cells(1, 1).Text
Dim objSheet As Worksheet
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Name = MyCol.Cells(1, 1).Text Then
End 'MsgBox "A worksheet with that name already exists."
Worksheets(MyCol.Cells(1, 1).Text).Activate
End If
Next objSheet
Worksheets.Add ' I ADD HERE WORKSHEETS,
WorkBook.add ' HERE IS A EXAMPLE OF HOW I ADD A WORKBOOK
' MsgBox "hej"
ActiveSheet.Name = MyCol.Cells(1, 1).Text ' HERE I GIVE THE NAME OF THE WORKSHEET.
End If
Next
Next
Next
End Sub