Hello,

Yes that did work, not bad, still going to save alot of time.

Thanks and if you ever come up with something else, let me know.

Thanks.

Have a good weekend.

Dejan

"Bernie Deitrick" wrote:

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