Hi all,
I'm trying to put together a macro which will first create a new workbook sheet for each
cell which holds a value within a given range. The new sheets are named after each
cells value in the range. I got this part to work.
Next, I want to copy the cell values in each row of another sheet to one of the new sheets, if the value found in col. "B" of the other sheet matches the newly created sheets name. I think I might almost have it. I just need to figure a way to make it loop
through each row data for each new sheet that's been created.
Here a Step by Step "Logic" Flow Example:
Sheet 1. Range("S7").value = "Red
Sheet 1.Range("S8").value ="Blue"
Sheet 1.Range("S9").value="Green"
(3) New sheets are created after values found in Range: Red,Blue,Green
Sheet2.Range("B25:B").Find("Red,Blue,Green")
For Each Red in Range Then
ws.("Red").Cells(LastRow, "C").Value = cell.Offset(0, 1).Value
ws.("Red").Cells(LastRow, "D").Value = cell.Offset(0, 2).Value
ws.("Red").Cells(LastRow, "E").Value = cell.Offset(0, 3).Value
ws.("Red").Cells(LastRow, "F").Value = cell.Offset(0, 4).Value
For Each Blue in Range Then
ws.("Blue").Cells(LastRow, "C").Value = cell.Offset(0, 1).Value
ws.("Blue").Cells(LastRow, "D").Value = cell.Offset(0, 2).Value
ws.("Blue").Cells(LastRow, "E").Value = cell.Offset(0, 3).Value
ws.("Blue").Cells(LastRow, "F").Value = cell.Offset(0, 4).Value
For Each Green in Range Then
ws.("Green").Cells(LastRow, "C").Value = cell.Offset(0, 1).Value
ws.("Green").Cells(LastRow, "D").Value = cell.Offset(0, 2).Value
ws.("Green").Cells(LastRow, "E").Value = cell.Offset(0, 3).Value
ws.("Green").Cells(LastRow, "F").Value = cell.Offset(0, 4).Value
Since the number of new sheets created is dependent on the number of cells with a value in the first range given
I'd actually like to have the data copy to the new sheets within the For loop
after the sheets is created, if possible.
The way I don't have to specifically name the new sheet for where the data is to be copied.
However, I found out you cannot
have to For Each,Loop within another For Each,Loop.
So the copying of the data may have to happen after all sheets have been created
and the process steps out of the sheet creation loop.
Here's the code I've put together.
Sub Create_NEW_Sheet_And_Copy_Specific_DATA_it ()
Dim ws As Worksheet
Dim wsName As String
Dim r As Range
Dim cell As Range
Dim rng As Range
Set r = Sheets("Master").Range("S7:S10")
If r Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each cell In r
If Not IsEmpty(cell) Then
With cell
newname = cell.Value
Set ws = Worksheets.Add
ws.Move After:=Sheets(Sheets.Count)
ws.Name = newname
End With
End If
Next cell
'For Each sht In ActiveWorkbook.Worksheets
' MsgBox sht.Name
With Sheets("BOM")
Sheets("BOM").Activate
Set rng = Range("$A$25:$G$" & Cells(Rows.Count, "B").End(xlUp).Row)
For Each cell In rng
'On Error Resume Next
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 7
If cell.Value = ws.Name Then
With cell
ws.Cells(LastRow, "C").Value = cell.Offset(0, 1).Value
ws.Cells(LastRow, "D").Value = cell.Offset(0, 2).Value
ws.Cells(LastRow, "E").Value = cell.Offset(0, 3).Value
ws.Cells(LastRow, "F").Value = cell.Offset(0, 4).Value
ws.Cells(LastRow, "G").Value = cell.Offset(0, 5).Value
End With
End If
Next cell
End With
Any help ,as always is greatly appreciated.
Thanks,
BDB
Bookmarks