Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy worksheets to new worksheet and add a worksheet name column t
I'm not sure about your deleting rows, but try the following (I used
variables instead of hard coding your columns, rows, and worksheet names. It makes adjusting in the future easier): Sub CombinedStatus() Dim headerRow As Long Dim dataRow As Long Dim combineWorksheet As Integer Dim dataWorksheetStart As Integer Dim worksheetColumn As String Dim pasteColumn As String Dim worksheetIndex As Integer Dim lastRow As Long Dim pasteRow As Long 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 ExtractSheet As Integer Dim ExtractCol, InsertCol, MaxInsertCol As Integer Dim MatchCol As Variant 'Setup variables (could make constants above procedure declaration) headerRow = 1 dataRow = 2 combineWorksheet = 1 dataWorksheetStart = 2 worksheetColumn = "A" pasteColumn = "B" filtercolumn = "J" 'Intialize first worksheet (delete any previous data) Worksheets(combineWorksheet).Range("A1:IV65536").D elete shift:=xlUp Worksheets(combineWorksheet).Name = "CombinedStatus" 'Copy headings from start data worksheet Worksheets(dataWorksheetStart).Rows(headerRow).Cop y Worksheets(combineWorksheet).Rows(headerRow).Paste 'Change name of column filterColumn Worksheets(combineWorksheet).Column(filtercolumn). Name = "DT_LOAD" 'Loop through data worksheets For worksheetIndex = dataWorksheetStart To Worksheets.Count 'Get row count of region to copy copyrowcount = Worksheets(worksheetIndex).CurrentRegion.Rows.Coun t - 1 'Copy cells in source worksheet Worksheets(worksheetIndex).CurrentRegion.Offset(1, 0). _ Resize(Selection.Rows.Count - 1).Copy 'Paste in combined worksheet starting in paste column at last row lastRow = Worksheets(combineWorksheet).Range("A65536").End(x lUp).Row Worksheets(combineWorksheet).Range(pasteColumn & lastRow).Paste 'Enter worksheet name in worksheetColumn For pasteRow = lastRow To (lastRow + copyrowcount - 1) Worksheets(combineWorksheet).Range(worksheetColumn & pasteRow) = _ Worksheets(worksheetIndex).Name Next Next 'Turn on filter With Worksheets(combineWorksheet).Columns(filtercolumn) .AutoFilter .AutoFilter Field:=1, Criteria1:="<09/06/2006", Operator:=xlAnd End With 'Unsure what you are doing here?? Worksheets(combineWorksheet).Rows("2:797").Select Selection.Delete shift:=xlUp Selection.AutoFilter Field:=1 'Sort data Selection.Sort Key1:=Range("I2"), Order1:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers Worksheets(combineWorksheet).Range(worksheetColumn & headerRow & ":" & _ filtercolumn & headerRow).AutoFilter With Worksheets(combineWorksheet).Columns(worksheetcol & ":" & filtercolumn) .AutoFit .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With End Sub "Lib" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy worksheet into several worksheets in the same or another work | New Users to Excel | |||
Copy worksheet into several worksheets in the same or another work | Excel Discussion (Misc queries) | |||
Copy formats and formulae from 1 worksheet to all worksheets in f | Excel Discussion (Misc queries) | |||
copy specified cells from different worksheets to one worksheet | Excel Discussion (Misc queries) | |||
How do I copy each row from 1 Worksheet to separate Worksheets? | Excel Discussion (Misc queries) |