Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
Dow Dow is offline
external usenet poster
 
Posts: 31
Default Loop and append to different worksheets

I posted this previously but I have discovered a few more things about
it and still need some help.

I need help making this macro loop through more than one worksheet.
And I need to make sure that the information appends correctly. Or I
need a different Macro that will do that. I have looked at
http://www.contextures.com/excelfiles.html and unfortunately the
macros there did not quite do what I need.

I have anywhere from one to 16 different worksheets with no duplicate
information. It is all in the same format, the worksheet names will
differ from month to month.

What I need to do is create new worksheets based on the information
from a column. Column K could have anywhere from 1 to 6 different
values A, B, C, D, E, or F. I need a seperate worksheet with all the
rows containing the A's, all the B's, etc.

This macro works great on one worksheet. I have tried a few things to
make it work on more than one but I have had no luck and I know there
are a lot of people here with much more experiance than I have. Thank
you for any help you can provide.

From a post by Bernie Deitrick:
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(0,
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
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell


'Optional section to export the sheets to separate files
'For Each mySht In ActiveWorkbook.Worksheets
'If mySht.Name = myShtName Then
'Exit Sub
'Else
'mySht.Move
'ActiveWorkbook.SaveAs "Workbook " & ActiveSheet.Name & ".xls"
'ActiveWorkbook.Close
'End If
'Next mySht


End Sub
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default Loop and append to different worksheets

The code gets all the sheet names at the beginning. Then loop through this
list of names. The way when you add a new sheet the code doesn't look at the
new sheets only the old sheets.


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 sheetnames() As Variant
ReDim sheetnames(Sheets.Count)
Index = 0
For Each sht In ThisWorkbook.Sheets
sheetnames(Index) = sht.Name
Index = Index + 1
Next sht

For Each sht In sheetnames

myShtName = ActiveSheet.Name
KeyCol = InputBox("What column # within database to use as key?")


Set myArea = sht.ActiveCell.CurrentRegion. _
Columns(KeyCol).Offset(0, 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
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell

Next sht

End Sub

"Dow" wrote:

I posted this previously but I have discovered a few more things about
it and still need some help.

I need help making this macro loop through more than one worksheet.
And I need to make sure that the information appends correctly. Or I
need a different Macro that will do that. I have looked at
http://www.contextures.com/excelfiles.html and unfortunately the
macros there did not quite do what I need.

I have anywhere from one to 16 different worksheets with no duplicate
information. It is all in the same format, the worksheet names will
differ from month to month.

What I need to do is create new worksheets based on the information
from a column. Column K could have anywhere from 1 to 6 different
values A, B, C, D, E, or F. I need a seperate worksheet with all the
rows containing the A's, all the B's, etc.

This macro works great on one worksheet. I have tried a few things to
make it work on more than one but I have had no luck and I know there
are a lot of people here with much more experiance than I have. Thank
you for any help you can provide.

From a post by Bernie Deitrick:
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(0,
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
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell


'Optional section to export the sheets to separate files
'For Each mySht In ActiveWorkbook.Worksheets
'If mySht.Name = myShtName Then
'Exit Sub
'Else
'mySht.Move
'ActiveWorkbook.SaveAs "Workbook " & ActiveSheet.Name & ".xls"
'ActiveWorkbook.Close
'End If
'Next mySht


End Sub

  #3   Report Post  
Posted to microsoft.public.excel.programming
Dow Dow is offline
external usenet poster
 
Posts: 31
Default Loop and append to different worksheets

Thank you for the response. I popped this code into my excel and got
an error at this point:

Set myArea = sht.ActiveCell.CurrentRegion. _
Columns(KeyCol).Offset(0, 0).Cells

Unfortunately I will not have time to play around with it until next
week. I do hope to continue working on it then.

Thank you again.

On Mar 14, 8:00*am, Joel wrote:
The code gets all the sheet names at the beginning. *Then loop through this
list of names. *The way when you add a new sheet the code doesn't look at the
new sheets only the old sheets.

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 sheetnames() As Variant
ReDim sheetnames(Sheets.Count)
Index = 0
For Each sht In ThisWorkbook.Sheets
* *sheetnames(Index) = sht.Name
* *Index = Index + 1
Next sht

For Each sht In sheetnames

* *myShtName = ActiveSheet.Name
* *KeyCol = InputBox("What column # within database to use as key?")

* *Set myArea = sht.ActiveCell.CurrentRegion. _
* * * Columns(KeyCol).Offset(0, 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
* * * * *.SpecialCells(xlCellTypeVisible).Copy _
* * * * *mySht.Range("A1")
* * * * *mySht.Cells.EntireColumn.AutoFit
* * * * *.AutoFilter
* * * End With
* * * Resume
SheetExists:
* *Next myCell

Next sht

End Sub



"Dow" wrote:
I posted this previously but I have discovered a few more things about
it and still need some help.


I need help making this macro loop through more than one worksheet.
And I need to make sure that the information appends correctly. *Or I
need a different Macro that will do that. *I have looked at
http://www.contextures.com/excelfiles.htmland unfortunately the
macros there did not quite do what I need.


I have anywhere from one to 16 different worksheets with no duplicate
information. *It is all in the same format, the worksheet names will
differ from month to month.


What I need to do is create new worksheets based on the information
from a column. *Column K could have anywhere from 1 to 6 different
values A, B, C, D, E, or F. *I need a seperate worksheet with all the
rows containing the A's, all the B's, etc.


This macro works great on one worksheet. *I have tried a few things to
make it work on more than one but I have had no luck and I know there
are a lot of people here with much more experiance than I have. *Thank
you for any help you can provide.


From a post by Bernie Deitrick:
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(0,
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
* * .SpecialCells(xlCellTypeVisible).Copy _
* * * * mySht.Range("A1")
* * mySht.Cells.EntireColumn.AutoFit
* * .AutoFilter
End With
Resume
SheetExists:
Next myCell


'Optional section to export the sheets to separate files
'For Each mySht In ActiveWorkbook.Worksheets
'If mySht.Name = myShtName Then
'Exit Sub
'Else
'mySht.Move
'ActiveWorkbook.SaveAs "Workbook " & ActiveSheet.Name & ".xls"
'ActiveWorkbook.Close
'End If
'Next mySht


End Sub- Hide quoted text -


- Show quoted text -


  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 9,101
Default Loop and append to different worksheets

I just copied your original code. Why not make you code a lot simplier with
this code below

from
Set myArea = sht.ActiveCell.CurrentRegion. _
Columns(KeyCol).Offset(0, 0)
Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)
to
set myarea = sht.columns(keycol)

"Dow" wrote:

Thank you for the response. I popped this code into my excel and got
an error at this point:

Set myArea = sht.ActiveCell.CurrentRegion. _
Columns(KeyCol).Offset(0, 0).Cells

Unfortunately I will not have time to play around with it until next
week. I do hope to continue working on it then.

Thank you again.

On Mar 14, 8:00 am, Joel wrote:
The code gets all the sheet names at the beginning. Then loop through this
list of names. The way when you add a new sheet the code doesn't look at the
new sheets only the old sheets.

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 sheetnames() As Variant
ReDim sheetnames(Sheets.Count)
Index = 0
For Each sht In ThisWorkbook.Sheets
sheetnames(Index) = sht.Name
Index = Index + 1
Next sht

For Each sht In sheetnames

myShtName = ActiveSheet.Name
KeyCol = InputBox("What column # within database to use as key?")

Set myArea = sht.ActiveCell.CurrentRegion. _
Columns(KeyCol).Offset(0, 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
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell

Next sht

End Sub



"Dow" wrote:
I posted this previously but I have discovered a few more things about
it and still need some help.


I need help making this macro loop through more than one worksheet.
And I need to make sure that the information appends correctly. Or I
need a different Macro that will do that. I have looked at
http://www.contextures.com/excelfiles.htmland unfortunately the
macros there did not quite do what I need.


I have anywhere from one to 16 different worksheets with no duplicate
information. It is all in the same format, the worksheet names will
differ from month to month.


What I need to do is create new worksheets based on the information
from a column. Column K could have anywhere from 1 to 6 different
values A, B, C, D, E, or F. I need a seperate worksheet with all the
rows containing the A's, all the B's, etc.


This macro works great on one worksheet. I have tried a few things to
make it work on more than one but I have had no luck and I know there
are a lot of people here with much more experiance than I have. Thank
you for any help you can provide.


From a post by Bernie Deitrick:
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(0,
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
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell


'Optional section to export the sheets to separate files
'For Each mySht In ActiveWorkbook.Worksheets
'If mySht.Name = myShtName Then
'Exit Sub
'Else
'mySht.Move
'ActiveWorkbook.SaveAs "Workbook " & ActiveSheet.Name & ".xls"
'ActiveWorkbook.Close
'End If
'Next mySht


End Sub- Hide quoted text -


- Show quoted text -



  #5   Report Post  
Posted to microsoft.public.excel.programming
Dow Dow is offline
external usenet poster
 
Posts: 31
Default Loop and append to different worksheets

I start with 2 or 3 workbooks. This code still works on only the
first one. How can we make it loop through the second workbook and
add the data to the newly created worksheets?

On Mar 14, 1:23*pm, Joel wrote:
I just copied your original code. *Why not make you code a lot simplier with
this code below

from
* *Set myArea = sht.ActiveCell.CurrentRegion. _
* * * Columns(KeyCol).Offset(0, 0)
* *Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)
to
set myarea = sht.columns(keycol)



"Dow" wrote:
Thank you for the response. *I popped this code into my excel and got
an error at this point:


* *Set myArea = sht.ActiveCell.CurrentRegion. _
* * * Columns(KeyCol).Offset(0, 0).Cells


Unfortunately I will not have time to play around with it until next
week. *I do hope to continue working on it then.


Thank you again.


On Mar 14, 8:00 am, Joel wrote:
The code gets all the sheet names at the beginning. *Then loop through this
list of names. *The way when you add a new sheet the code doesn't look at the
new sheets only the old sheets.


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 sheetnames() As Variant
ReDim sheetnames(Sheets.Count)
Index = 0
For Each sht In ThisWorkbook.Sheets
* *sheetnames(Index) = sht.Name
* *Index = Index + 1
Next sht


For Each sht In sheetnames


* *myShtName = ActiveSheet.Name
* *KeyCol = InputBox("What column # within database to use as key?")


* *Set myArea = sht.ActiveCell.CurrentRegion. _
* * * Columns(KeyCol).Offset(0, 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
* * * * *.SpecialCells(xlCellTypeVisible).Copy _
* * * * *mySht.Range("A1")
* * * * *mySht.Cells.EntireColumn.AutoFit
* * * * *.AutoFilter
* * * End With
* * * Resume
SheetExists:
* *Next myCell


Next sht


End Sub


"Dow" wrote:
I posted this previously but I have discovered a few more things about
it and still need some help.


I need help making this macro loop through more than one worksheet.
And I need to make sure that the information appends correctly. *Or I
need a different Macro that will do that. *I have looked at
http://www.contextures.com/excelfile...dunfortunately the
macros there did not quite do what I need.


I have anywhere from one to 16 different worksheets with no duplicate
information. *It is all in the same format, the worksheet names will
differ from month to month.


What I need to do is create new worksheets based on the information
from a column. *Column K could have anywhere from 1 to 6 different
values A, B, C, D, E, or F. *I need a seperate worksheet with all the
rows containing the A's, all the B's, etc.


This macro works great on one worksheet. *I have tried a few things to
make it work on more than one but I have had no luck and I know there
are a lot of people here with much more experiance than I have. *Thank
you for any help you can provide.


From a post by Bernie Deitrick:
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(0,
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
* * .SpecialCells(xlCellTypeVisible).Copy _
* * * * mySht.Range("A1")
* * mySht.Cells.EntireColumn.AutoFit
* * .AutoFilter
End With
Resume
SheetExists:
Next myCell


'Optional section to export the sheets to separate files
'For Each mySht In ActiveWorkbook.Worksheets
'If mySht.Name = myShtName Then
'Exit Sub
'Else
'mySht.Move
'ActiveWorkbook.SaveAs "Workbook " & ActiveSheet.Name & ".xls"
'ActiveWorkbook.Close
'End If
'Next mySht


End Sub- Hide quoted text -


- Show quoted text -- Hide quoted text -


- Show quoted text -




  #6   Report Post  
Posted to microsoft.public.excel.programming
Dow Dow is offline
external usenet poster
 
Posts: 31
Default Loop and append to different worksheets

On Mar 18, 10:42*am, Dow wrote:
I start with 2 or 3 workbooks. *This code still works on only the
first one. *How can we make it loop through the second workbook and
add the data to the newly created worksheets?

On Mar 14, 1:23*pm, Joel wrote:



I just copied your original code. *Why not make you code a lot simplier with
this code below


from
* *Set myArea = sht.ActiveCell.CurrentRegion. _
* * * Columns(KeyCol).Offset(0, 0)
* *Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)
to
set myarea = sht.columns(keycol)


"Dow" wrote:
Thank you for the response. *I popped this code into my excel and got
an error at this point:


* *Set myArea = sht.ActiveCell.CurrentRegion. _
* * * Columns(KeyCol).Offset(0, 0).Cells


Unfortunately I will not have time to play around with it until next
week. *I do hope to continue working on it then.


Thank you again.


On Mar 14, 8:00 am, Joel wrote:
The code gets all the sheet names at the beginning. *Then loop through this
list of names. *The way when you add a new sheet the code doesn't look at the
new sheets only the old sheets.


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 sheetnames() As Variant
ReDim sheetnames(Sheets.Count)
Index = 0
For Each sht In ThisWorkbook.Sheets
* *sheetnames(Index) = sht.Name
* *Index = Index + 1
Next sht


For Each sht In sheetnames


* *myShtName = ActiveSheet.Name
* *KeyCol = InputBox("What column # within database to use as key?")


* *Set myArea = sht.ActiveCell.CurrentRegion. _
* * * Columns(KeyCol).Offset(0, 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
* * * * *.SpecialCells(xlCellTypeVisible).Copy _
* * * * *mySht.Range("A1")
* * * * *mySht.Cells.EntireColumn.AutoFit
* * * * *.AutoFilter
* * * End With
* * * Resume
SheetExists:
* *Next myCell


Next sht


End Sub


"Dow" wrote:
I posted this previously but I have discovered a few more things about
it and still need some help.


I need help making this macro loop through more than one worksheet..
And I need to make sure that the information appends correctly. *Or I
need a different Macro that will do that. *I have looked at
http://www.contextures.com/excelfile...fortunatelythe
macros there did not quite do what I need.


I have anywhere from one to 16 different worksheets with no duplicate
information. *It is all in the same format, the worksheet names will
differ from month to month.


What I need to do is create new worksheets based on the information
from a column. *Column K could have anywhere from 1 to 6 different
values A, B, C, D, E, or F. *I need a seperate worksheet with all the
rows containing the A's, all the B's, etc.


This macro works great on one worksheet. *I have tried a few things to
make it work on more than one but I have had no luck and I know there
are a lot of people here with much more experiance than I have. *Thank
you for any help you can provide.


From a post by Bernie Deitrick:
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(0,
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
* * .SpecialCells(xlCellTypeVisible).Copy _
* * * * mySht.Range("A1")
* * mySht.Cells.EntireColumn.AutoFit
* * .AutoFilter
End With
Resume
SheetExists:
Next myCell


'Optional section to export the sheets to separate files
'For Each mySht In ActiveWorkbook.Worksheets
'If mySht.Name = myShtName Then
'Exit Sub
'Else
'mySht.Move
'ActiveWorkbook.SaveAs "Workbook " & ActiveSheet.Name & ".xls"
'ActiveWorkbook.Close
'End If
'Next mySht


End Sub- Hide quoted text -


- Show quoted text -- Hide quoted text -


- Show quoted text -- Hide quoted text -


- Show quoted text -


Let me correct what I wrote above. I start with 2 or 3 worksheets.
And I would like to loop through the worksheets. They are all in the
same workbook.
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Is it possible to Append worksheets in the same excel file? Angie33 Excel Discussion (Misc queries) 3 August 7th 08 04:58 PM
How do I append 20 worksheets in single sheet. Rahul Excel Worksheet Functions 2 August 3rd 08 03:08 PM
Append info in all worksheets in workbook in one sheet Barb Reinhardt Excel Programming 6 December 21st 05 08:55 PM
Append worksheets together in one bioyyy Excel Discussion (Misc queries) 1 October 14th 05 07:10 AM
append two worksheets with excel macro Moon Excel Programming 0 March 22nd 05 09:47 PM


All times are GMT +1. The time now is 06:54 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"