Hello Everyone,

First I would like to thank anyone in advance who is willing to tackl
this problem with me.

New guy here. I've been working on this Macro that splits up my dat
from a master sheet and splits it into many different tabs and name
them according to the account number which is in the far most righ
coloumn. It groups all of the specific accounts activity in the on
tab.

The problem I have is after I copy about 15 sheets or so it brings u
this error:

Excel cannot complete this taks with available resources. Choose les
data
or close other applications.

I push OK

then it says:

Run-Time error '1004':

PasteSpecial method of Range class failed

I push Debug

it highlights

mySht.Range("A1").PasteSpecial xlPasteValues

If i push End

it says:

The picture is too large and will be truncated.

I push OK

and it comes up two more times and the book closes.


vba code


Option Explicit

Private Declare Function OpenClipboard Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long

Sub ExportDatabaseToSeparateFiles()
'Export is based on the value in the desired column

Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range
Dim myShtName As String
Dim KeyCol As Integer

myShtName = ActiveSheet.Name
KeyCol = InputBox("What column # within database to use as key?")

Set myArea = ActiveCell.CurrentRegion.Columns(KeyCol).Offset(1
0).Cells

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)

For Each myCell In myArea
On Error GoTo NoSheet
myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
mySht.Range("A1").PasteSpecial xlPasteFormats
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
ClearCipboard
Application.CutCopyMode = False

End With
Resume
SheetExists:
Next myCell

End Sub

Sub ClearClipboard()
OpenClipboard Application.hwnd
EmptyClipboard
CloseClipboard
End Sub

end vba

Thanks so much for your help...

Deja

+-------------------------------------------------------------------
|Filename: tEST.zip
|Download: http://www.excelforum.com/attachment.php?postid=3883
+-------------------------------------------------------------------

--
windso
-----------------------------------------------------------------------
windsor's Profile: http://www.excelforum.com/member.php...fo&userid=2784
View this thread: http://www.excelforum.com/showthread.php?threadid=47358