View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Norman Jones Norman Jones is offline
external usenet poster
 
Posts: 5,302
Default Copy fixed range of multiple sheets into new workbook

Hi A,

Try something like:

Public Sub aTester001()
Dim srcWB As Workbook
Dim destWB As Workbook
Dim SH As Worksheet
Dim destSH As Worksheet
Dim srcRng As Range
Dim blOK As Boolean
Const sStr As String = "PY" '<<=== CHANGE

Set srcWB = Workbooks("MyBokk.xls") '<<=== CHANGE

blOK = True
For Each SH In srcWB.Worksheets
If UCase(SH.Name) Like UCase("*" & sStr) Then
If blOK Then
Set destWB = Workbooks.Add
End If
blOK = False
With destWB
Set destSH = .Sheets.Add( _
After:=.Sheets(.Sheets.Count))
End With
With destSH
.Name = SH.Name
SH.Range("B4:S40").Copy Destination:=.Range("A1")
End With
End If
Next SH

End Sub
'<<=============


---
Regards,
Norman


"A. Karatas" wrote in message
ups.com...
I have a workbook with multiple sheets in them. I want to copy a
particular fixed range of each sheet, in which the sheetname ends on
PY) into a new workbook. For example sheetname= Emuls(actual vs PY)
range b4:s40.

Each range has to be copied into a (seperate) new sheet with the
sheetname it had on the original workbook.

I have no clou how to start the procedure????

thankx in advance