PDA

View Full Version : Combine specific worksheets and columns with modified generic code



MILK1123
08-14-2011, 09:00 AM
I'd like to combine specific worksheets with specific columns from each worksheet into a master worksheet, and keep them sorted by date. For example Columns A, B, C from Worksheets 2010, 2009, 2008 where column A in each worksheet is a date. The columns in each worksheet have the same data and headers. I copied the generic code from msdn.microsoft.com to combine multiple worksheets, but I dont know which lines or what to put in those lines to suit my needs. Obviously, I'm a novice and would appreciate any help. Cutting and pasting is very time consuming. :help Here is the code I copied.

Sub CopyDataWithoutHeaders()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Delete the summary sheet if it exists.
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True
' Add a new summary worksheet.
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "RDBMergeSheet"
' Fill in the start row.
StartRow = 2
' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
' Find the last row with data on the summary
' and source worksheets.
Last = LastRow(DestSh)
shLast = LastRow(sh)
' If source worksheet is not empty and if the last
' row >= StartRow, copy the range.
If shLast > 0 And shLast >= StartRow Then
'Set the range that you want to copy
Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))
' Test to see whether there are enough rows in the summary
' worksheet to copy all the data.
If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
MsgBox "There are not enough rows in the " & _
"summary worksheet to place the data."
GoTo ExitTheSub
End If
' This statement copies values and formats.
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
End If
End If
Next
ExitTheSub:
Application.Goto DestSh.Cells(1)
' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

CatDaddy
08-16-2011, 03:06 PM
Sub CombineWS()
ActiveWorkbook.Sheets(1).Activate
Range("A1").Activate
Dim i As Integer
For i = 4 To 2 Step -1
Sheets(i).Activate
Range("A2:C" & Range("A65600").End(xlUp).Row).Select
Selection.Copy Destination:=Worksheets("Master").Range("A" & Worksheets("Master").Range("A65600").End(xlUp).Offset(1, 0).Row)
Next i
Worksheets("Master").Activate
Columns("A:A").Select
ActiveWorkbook.Worksheets("Master").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Master").Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Master").Sort
.SetRange Range("A2:C20")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub