W
Wester
Hi,
I found this macro and modified it a bit. It does a great job coping rows
from a "main" sheet into multiple sheets based off a column value. But it
names the sheet of the column value. Because my sheets are already named
something different. I am struggling now to go to a deeper level were it
will copy the row based on one column value within each worksheet throughout
the entire workbook. I want to compare and look at the same column of all
sheets in my workbook (column B in my case) and copy the row of matching data
from my "main" sheet (column B).
So I want all my rows that have "excel.exe" in my "main" sheet to go to my
"MS Excel" named sheet and all my "winprog.exe" rows to go my "MS Project"
named sheet and etc.
Any assistance would be appreciated!
Thanks
Wesley
Sub CopyRowsToSheets()
'copy rows to worksheets based on value in column A
'assume the worksheet name to paste to is the value in Col A
Dim CurrentCell As Range
Dim SourceRow As Range
Dim Targetsht As Worksheet
Dim TargetRow As Long
Dim CurrentCellValue As String
'start with cell A2 on "Master" sheet
Set CurrentCell = Worksheets("Master").Cells(2, 1) 'row ... column ...
Do While Not IsEmpty(CurrentCell)
CurrentCellValue = CurrentCell.Value
Set SourceRow = CurrentCell.EntireRow
'Check if worksheet exists
On Error Resume Next
Testwksht = Worksheets(CurrentCellValue).Name
If Err.Number = 0 Then
'MsgBox CurrentCellValue & " worksheet Exists"
Else
MsgBox "Adding a new worksheet for " & CurrentCellValue
Worksheets.Add.Name = CurrentCellValue
End If
On Error GoTo 0 'reset on error to trap errors again
Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue)
' Find next blank row in Targetsht - check using Column A
TargetRow = Targetsht.Cells(Rows.Count, 1).End(xlUp).Row + 1
SourceRow.Copy Destination:=Targetsht.Cells(TargetRow, 1)
'do the next cell
Set CurrentCell = CurrentCell.Offset(1, 0)
Loop
End Sub
I found this macro and modified it a bit. It does a great job coping rows
from a "main" sheet into multiple sheets based off a column value. But it
names the sheet of the column value. Because my sheets are already named
something different. I am struggling now to go to a deeper level were it
will copy the row based on one column value within each worksheet throughout
the entire workbook. I want to compare and look at the same column of all
sheets in my workbook (column B in my case) and copy the row of matching data
from my "main" sheet (column B).
So I want all my rows that have "excel.exe" in my "main" sheet to go to my
"MS Excel" named sheet and all my "winprog.exe" rows to go my "MS Project"
named sheet and etc.
Any assistance would be appreciated!
Thanks
Wesley
Sub CopyRowsToSheets()
'copy rows to worksheets based on value in column A
'assume the worksheet name to paste to is the value in Col A
Dim CurrentCell As Range
Dim SourceRow As Range
Dim Targetsht As Worksheet
Dim TargetRow As Long
Dim CurrentCellValue As String
'start with cell A2 on "Master" sheet
Set CurrentCell = Worksheets("Master").Cells(2, 1) 'row ... column ...
Do While Not IsEmpty(CurrentCell)
CurrentCellValue = CurrentCell.Value
Set SourceRow = CurrentCell.EntireRow
'Check if worksheet exists
On Error Resume Next
Testwksht = Worksheets(CurrentCellValue).Name
If Err.Number = 0 Then
'MsgBox CurrentCellValue & " worksheet Exists"
Else
MsgBox "Adding a new worksheet for " & CurrentCellValue
Worksheets.Add.Name = CurrentCellValue
End If
On Error GoTo 0 'reset on error to trap errors again
Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue)
' Find next blank row in Targetsht - check using Column A
TargetRow = Targetsht.Cells(Rows.Count, 1).End(xlUp).Row + 1
SourceRow.Copy Destination:=Targetsht.Cells(TargetRow, 1)
'do the next cell
Set CurrentCell = CurrentCell.Offset(1, 0)
Loop
End Sub