Sorry to take it offline, but I couldn’t understand the issue at hand. The
problem was resolved with two macros:
‘This macro creates a new sheet for every item in the chosen Column,
'and copies the data that matches the values in the chosen column…
'it uses Excels AutoFilter tool.
Sub ExportDatabaseToSeparateSheets()
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 = Range("A6").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
On Error Resume Next
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub
‘This macro copies the values in each cell D1 in each sheet,
'and pastes all values in column B, staring in B6 on the TOC sheet
Sub CopyD1()
Dim ws As Worksheet
Dim rCopy As Range
Dim rDest As Range
Set rDest = ActiveWorkbook.Worksheets("TOC").Range("B6")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "TOC" And ws.Name <> "template" And ws.Name <>
"list" Then
rDest.Offset(0, -1).Value = ws.Name
With ws.Range("D1")
rDest.Resize(1, .Columns.Count).Value = .Value
End With
Set rDest = rDest.Offset(1, 0)
End If
Next ws
End Sub
Ryan---