View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Ron de Bruin Ron de Bruin is offline
external usenet poster
 
Posts: 11,123
Default Copy from Multiple Sheets

Hi Eric

I change the first sub on the page for you.
Add a worksheet to the workbook first with the name "Master"

Copy the sub and the function in a normal module

Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

Application.ScreenUpdating = False
Set DestSh = Worksheets("Master")
For Each sh In ActiveWindow.SelectedSheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)

sh.Range("A1:C5").Copy DestSh.Cells(Last + 1, "A")
'Instead of this line you can use the code below to copy only the values
'or use the PasteSpecial option to paste the format also.


'With sh.Range("A1:C5")
'DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _
'.Columns.Count).Value = .Value
'End With


'sh.Range("A1:C5").Copy
'With DestSh.Cells(Last + 1, "A")
' .PasteSpecial xlPasteValues, , False, False
' .PasteSpecial xlPasteFormats, , False, False
' Application.CutCopyMode = False
'End With

DestSh.Cells(Last + 1, "D").Value = sh.Name
'This will copy the sheet name in the D column if you want

End If
Next
Cells(1).Select
Application.ScreenUpdating = True
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function




--
Regards Ron de Bruin
http://www.rondebruin.nl


"Eric Byers" wrote in message ...
Do you have anything that will copy from only selected sheets. Forgive
me, I'm a VB novice.

Thanks



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!