Worksheet place in workbook
Thanx. I believe that the following code will do the trick but I need a
little help on exactly where it should go. Also, any way to add an code
for AFTER (sheet name "start")?
worksheets.Add Befo=worksheets("End")
Here's my insert sheet code.
Sub Cop_RowS_To_Sheets()
'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 Sheet1
Set CurrentCell = Worksheets("ALL ERRORS").Cells(2, 1) 'row 2 column 1
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)
'note: using CurrentCell.value gave me an error if the value was
numeric
' 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
|