Thread: Copy Code
View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Copy Code

This has a few more checks in it to try to avoid errors - perhaps this will
help:

Sub CurMonth()
Dim rng As Range, sh As Worksheet
Dim rng1 As Range, rng2 As Range
Set rng = Sheets("CasCrd").Rows("2:2")
Sheets("CasCrd").Range(rng, rng.End(xlDown)).Delete Shift:=xlUp

For Each sh In Worksheets
If InStr(1, sh.Name, Right( _
Sheets("Interface").[C2], 2), vbTextCompare) 0 Then
Set rng = sh.Range("A1").CurrentRegion
If rng.Columns.Count 1 And rng.Rows.Count 1 Then
sh.Range("A1").AutoFilter Field:=4, Criteria1:="N"
Set rng1 = sh.AutoFilter.Range.Resize(, 42).Offset(1, 0)
Set rng1 = rng1.Resize(rng1.Rows.Count - 1)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng1.Columns(1).SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng1.Copy _
Destination:=Sheets("CasCrd"). _
Range("A65536").End(xlUp).Offset(1, 0)
End If
sh.AutoFilterMode = False
End If
End If
Next
End Sub

--
Regards,
Tom Ogilvy

"Soniya" wrote in message
...
Hello Again,

istead of instr i tried to use mid and still it copies
from the first instance ang genrates an error instead og
moving to next matching sheet.

Rutime error 1004 copy method of range class faild?

what wud be causing this since the code seems to be so
simple?

Soniya

Sub CurMonth()
Dim rng As Range, sh As Worksheet
Set rng = Sheets("CasCrd").Rows("2:2")
Sheets("CasCrd").Range(rng, rng.End(xlDown)).Delete
Shift:=xlUp

For Each sh In Worksheets
If Mid(sh.Name, 2, 2) = Right( _
Sheets("Interface").[C2], 2) Then
sh.Range("A1").AutoFilter Field:=4, Criteria1:="N"
sh.AutoFilter.Range.Resize(, 42).Offset(1, 0).Copy _
Destination:=Sheets("CasCrd"). _
Range("A65536").End(xlUp).Offset(1, 0)
sh.AutoFilterMode = False
End If
Next
End Sub



-----Original Message-----
Sub CurMonth()
Dim rng as Range, sh as Worksheet
set rng = Sheets("CasCrd").Rows("2:2")
Sheets("CasCrd").Range(rng, rng.End(xlDown)).Delete

Shift:=xlUp

For Each Sh In WorkSheets
If Instr(1,Sh.Name, Right( _
Sheets("Interface").[C2],2),vbTextCompare) 0 then
sh.Range("A1").AutoFilter Field:=4, Criteria1:="N"
sh.Autofilter.Range.Resize(,42).Offset(1, 0).Copy _
Destination:=Sheets("CasCrd"). _
Range("A65536").End(xlUp).Offset(1, 0)
Sh.AutoFilterMode = False
End If
Next
End Sub

If it doesn't copy the data you expect, then you need to

check if what

Right(Sheets("Interface").[C2],2)

produces and if that value is found in any of the sheet

names.

--
Regards,
Tom Ogilvy


"Soniya" wrote in

message
...
Hi All,

I am having the following code which stpos after

copying
data from the first instance of the sheet. How cud i

fix
this problem?


Sub CurMonth()
Sheets("CasCrd").Select
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("Interface").Select

For Each Sh In Sheets
Sh.Select
If Mid(Sh.Name, 2, 2) = Right(Sheets("Interface").[C2],
2) Then

Range("A1").Select
Selection.AutoFilter Field:=4, Criteria1:="N"
Selection.End(xlDown).Select
Range(Selection, Range("AP1").Offset(1, 0)).Copy _
Destination:=Sheets("CasCrd").Range("A65536").End
(xlUp).Offset(1, 0)
Sh.AutoFilterMode = False
Range("A1").Select
End If
Next


End Sub



.