View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Lib Lib is offline
external usenet poster
 
Posts: 1
Default Copy worksheets to new worksheet and add a worksheet name column to new sheet.

I have a workbook that contains 6 sheets. I managed to create the
code to copy those sheets onto one worksheet. Now I want to add a
column to the new worksheet that lists the worksheet name for each row
that was copied from a particular worksheet. (That way, it will be
easier to identify which worksheet that row came from in the new
worksheet.) For example, say I copied four rows with five columns
from Worksheet "A" and 7 rows with five columns from Worksheet "B"
onto the new Worksheet "1". I want to create a new column in the
Worksheet "1" that will identify each row as either coming from
Worksheet A or coming from Worksheet B.

I'll take any help I can get! If you do post, please add comments to
explain what was exactly done. Thanks!

Here's my code so far:

Sub CombinedStatus()

Dim J As Integer
Dim InsertRow As Integer
Dim InsertSheet As Integer
Dim ExtractRow As Integer
Dim MaxColumns As Integer
Dim StartSheet As Integer
Dim StartRow As Integer
Dim HeaderRow As Integer
Dim ExtractSheet As Integer
Dim ExtractCol, InsertCol, MaxInsertCol As Integer
Dim MatchCol As Variant

On Error Resume Next
Sheets(1).Select
Sheets(1).Cells.Clear
Sheets(1).Interior.ColorIndex = xlNone
Sheets(1).Name = "CombinedStatus"

'copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
Sheets(1).Column("I").Name = "DT_LOAD"

' work through sheets
For J = 2 To 7 ' from sheet 2 to last sheet
' make the sheet active
Sheets(J).Activate
Range("A1").Select
' select all cells in this sheets
Selection.CurrentRegion.Select
' select all lines except title
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
' copy cells selected in the new sheet on last line
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)
(2)

Next
Sheets(1).Activate
Columns("I:I").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<09/06/2006",
Operator:=xlAnd
Rows("2:797").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=1

Selection.Sort Key1:=Range("I2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortTextAsNumbers
Range("A1:I1").Select
Selection.AutoFilter
Columns("A:I").Select
Selection.Columns.AutoFit
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:I").Select
Selection.Columns.HorizontalAlignment = xlCenter

End Sub