Help Modifying Macro

[Adams SC]

I am trying to modify the macro below so that when the new worksheets are
created and the information is pasted on them, formulas will not be converted
to values. Please help.

Sub ExportDatabaseToSeparateSheets()
'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
'These lines copy everything - including extra header rows
' and any SUBTOTAL formulas separated by blank row
'Uncomment them to use them
' myCell.Parent.Cells.SpecialCells(xlCellTypeVisible).Copy
' mySht.Range("A1").PasteSpecial xlPasteValues


'These are the default - only copy the database values
..SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
..AutoFilter
End With
Resume
SheetExists:
Next myCell

End Sub

 

[Simon Lloyd]

Just change the paste special lines like this
change this:

Code:
--------------------
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
mySht.Range("A1").PasteSpecial xlPasteValues
--------------------
for this:

Code:
--------------------
myCell.Parent.Cells.SpecialCells(xlCellTypeVisible).Copy Destination:=mySht.Range("A1")
--------------------

I am trying to modify the macro below so that when the new worksheets
are
created and the information is pasted on them, formulas will not be
converted
to values. Please help.
Code:
--------------------
Sub ExportDatabaseToSeparateSheets()
'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
'These lines copy everything - including extra header rows
' and any SUBTOTAL formulas separated by blank row
'Uncomment them to use them
' myCell.Parent.Cells.SpecialCells(xlCellTypeVisible).Copy
' mySht.Range("A1").PasteSpecial xlPasteValues


'These are the default - only copy the database values
..SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
..AutoFilter
End With
Resume
SheetExists:
Next myCell

End Sub
--------------------

--
Simon Lloyd

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com)

 

[Adams SC]

Works for the first few records, but then I get a message that Excel cannot
complete the task with the available resources. Worked before I made the
change.