View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.misc
Dallman Ross Dallman Ross is offline
external usenet poster
 
Posts: 390
Default Combining multiple sheets

In , Dallman Ross <dman@localhost.
spake thusly:

Another thing is, I want to drop the formatting when I copy.
(Then I'll add formatting latter in an add-on macro.) How
can I do that?


Okay, I've stuck this near the end of Ron's/JLatham's VBA after the
'Next' statement. It seems to do what I want with the formatting.
Not sure if there's a cleaner way.

'/* dman
' format stuff
DestSh.UsedRange.Select
With Selection
.Columns.WrapText = False
.Columns.AutoFit
.Interior.ColorIndex = xlNone 'unformat
Application.CutCopyMode = False
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=MOD(ROW(),2)"
.FormatConditions(1).Interior.ColorIndex = 24
End With

DestSh.Range("A1:F2").Select
With Selection
.Hyperlinks.Delete
.FormatConditions.Delete
.Interior.ColorIndex = 37
.HorizontalAlignment = xlCenter

.Font.FontStyle = "Bold"
.Font.ColorIndex = 11
End With
Range("F1:F2").Columns.AutoFit
'dman */

Now I'm going to figure out looking for value "Canceled" in Column
A and deleting those rows. Help with this would also be much
appreciated.

Dallman

---------------------------------------------------------------------
For the first request, copying from row 2 on first sheet, row 4
for the rest:

Add this to the variable declarations:
Dim sRow as Integer

then somewhere before the beginning of the For Each sh... loop
add this statement:
sRow = 2

Change the line that really does the work ( sh.Range(sh.Rows(2))...
to use sRow instead of 2:
sh.Range(sh.Rows(sRow))....
and right below that line of code add:
sRow=4

The first time the loop is run it will copy from row 2, and
after that it will always copy from row 4.
The code below includes those changes, plus it adds a test
within the loop to see if A4 is empty, and if it is empty,
the copy is not performed. Your 3rd request, not to copy
individual rows if they contain the word "Canceled" in column
A is a little more difficult since Ron's code (and even mine)
is copying a large area based on a start and end point and
without regard to what's in between. Probably best to add
another routine to go to the MergeSheet and delete rows that
have Canceled in column A after all of the work performed by
the loop in this code is finished. Here's my modification to
your displayed code
Sub Test3()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim sRow As Integer ' jlatham

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Delete the sheet "MergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("MergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "MergeSheet"
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"

'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
If Not IsEmpty(sh.Range("A4")) Then 'jlatham
Last = LastRow(DestSh)
shLast = LastRow(sh)

'This example copies everything, if you only want to copy
'values/formats look at the example below the first example
sh.Range(sh.Rows(sRow), sh.Rows(shLast)).Copy _
DestSh.Cells(Last + 1, "A")
sRow = 4 ' jlatham
End If ' jlatham
End If
Next

Application.Goto DestSh.Cells(1)

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub