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
|