Thread: Simple macro
View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
[email protected] paul.robinson@it-tallaght.ie is offline
external usenet poster
 
Posts: 789
Default Simple macro

Hi
Made a few changes. Comments are next to changed lines. Nothing in
your code filters anything, so a filter must be applied elsewhere.

Sub CTS()
Sheets("A").Select
Dim myrange as Range 'myrange not declared properly, copyrange not
needed
lastrow = Cells(Rows.Count, "F").End(xlUp).Row 'extra cells not
needed
Set myrange = Range("F1:F" & lastrow) .EntireRow 'includes Row 1 i.e.
copyrange
myrange.Copy
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "B"
ActiveSheet.Paste
With ActiveSheet
.Range("D:D,H:I,K:L,N:U,W:AD,AF:AT,AV:IV").Delete
End With
Worksheets("B").Activate
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
'sub doesn't set Displayalerts etc to false, so no need to make them
true
End Sub

regards
Paul


On Feb 22, 11:44*am, Gemz wrote:
Hi,

I have a code but cant figure out how to change it so its just copies
everything rather than filter and then copy, the reason it filters is because
i copied this code from a filer code (but did think i removed all the filter
code bit.. obviously not!)

I think it might be this bit that is causing the problem: lastrow =
Cells(Cells.Rows.Count, "F").End(xlUp).Row
Set myrange = Range("F1:F" & lastrow)

All the code:

Sub CTS()
Sheets("A").Select
Dim myrange, copyrange As Range
Set copyrange = Rows(1).EntireRow
lastrow = Cells(Cells.Rows.Count, "F").End(xlUp).Row
Set myrange = Range("F1:F" & lastrow)
For Each c In myrange

* * * * * * * * Set copyrange = Union(copyrange, c.EntireRow)

Next
copyrange.Copy
Worksheets.Add(After:=Worksheets(Worksheets.Count) ).Name = "B"
ActiveSheet.Paste
With ActiveSheet
* * * * .Range("D:D,H:I,K:L,N:U,W:AD,AF:AT,AV:IV").Delete

End With

* * Worksheets("B").Activate
* * * * Cells.Select
* * Cells.EntireColumn.AutoFit
* * Cells.EntireRow.AutoFit
With Application
* * .DisplayAlerts = True
* * .EnableEvents = True
* * .ScreenUpdating = True
End With
End Sub

thanks alot.