LinkBack URL
About LinkBacks
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(Before:=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
Register To Reply
Bookmarks