Hi windsor

I have not test your code but look here for another example
http://www.rondebruin.nl/copy5.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl


"windsor" wrote in message
...

Hello Everyone,

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

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

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

Excel cannot complete this taks with available resources. Choose less
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...

Dejan


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

--
windsor
------------------------------------------------------------------------
windsor's Profile: http://www.excelforum.com/member.php...o&userid=27849
View this thread: http://www.excelforum.com/showthread...hreadid=473581