According to Help, the message for Error 400 is "Form already displayed; can't
show modally". Are you sure that's the error number? On which line to you get
the error? Have you checked that the entries in column B correspond EXACTLY
with the sheet names? The following shows you one way to trap that error.

Notice, that as in the other code you were given, you don't need to select
and/or activate worksheets and cells to copy and paste.

Option Explicit

Sub Macro1()
Dim DestCell As Range
Dim DestSheet As String
Dim i As Long
Dim SrcCell As Range

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

For Each SrcCell In ActiveSheet.Range("B5", Cells(65536, 2).End(xlUp))
DestSheet = SrcCell.Value
If DestSheet = "" Then Exit For 'embedded blank cell -- quit

On Error Resume Next
i = Worksheets(DestSheet).Index
If Err.Number < 0 Then
MsgBox _
"There is no worksheet named '" & DestSheet & "'!", _
vbCritical + vbOKOnly
Exit For
End If
On Error GoTo 0

With Worksheets(DestSheet)
Set DestCell = .Cells(1, 1).End(xlDown)
If DestCell.Row = 26 Or DestCell.Row = 65536 Then
Set DestCell = .Cells(2, 1)
Else
Set DestCell = DestCell.Offset(1, 0)
End If
End With
SrcCell.EntireRow.Copy DestCell
Next SrcCell

With Application
.CutCopyMode = False
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub



On Sun, 6 Mar 2005 14:21:02 -0800, Michael A
wrote:

I get error 400 when i run this, I cant figure out whats causing it, can
anyone help please? What it should be doing is copying all the lines on the
sheet to there own proper sheets, using the value in the B column as the
sheet name, it should be copying them starting in the first row that is
unused. Thanks so much!


Sub Macro1()
ThisSheet = ActiveSheet.Name
Range("B4").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Do Until ActiveCell.Value = ""
ToSheet = ActiveCell.Value
ActiveCell.EntireRow.Copy
Sheets(ToSheet).Select
Range("A1").Select
Selection.End(xlDown).Select
If ActiveCell.Row = 26 Then
Range("A2").Select
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
ActiveSheet.Paste
Sheets(ThisSheet).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
Application.CutCopyMode = False
End Sub