Dejan,
What happens if you stop the macro and then restart it? Try this, which will only do a set number of
sheets (20) each time it is run.
HTH,
Bernie
MS Excel MVP
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
Dim Counter As Integer
Counter = 0
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
Application.CutCopyMode = False
ClearClipboard
End With
Counter = Counter +1
If Counter = 20 Then Exit Sub
Resume
SheetExists:
Next myCell
End Sub
"Dejan" wrote in message
...
Hello,
Sorry to bother again, did as you told, it did run a little longer but
still the same problem....
So i guess I'm back to square one then.
I really appreciate you tyring.
Dejan
|