Len Piwowar
09-14-2008, 04:49 PM
I have a procedure that copies and paste special some data to a new sheet, when the code is done the selected area is still selected. How do I turn off the selection using code?
Thanks in advance
Sub CopyAllCardData()
CurWeekNo = Application.ActiveWorkbook.Worksheets("Card").Range("CardWeek").Rows(2).Value
ShtNam = "Week" & CurWeekNo
On Error GoTo EndMacro
If ActiveWorkbook.Worksheets(ShtNam).Name <> "" Then
MsgBox "WorkSheet " & ShtNam & " Already Exist, must delete it!"
Exit Sub
End If
EndMacro:
Application.ScreenUpdating = False
Worksheets.Add After:=Worksheets("Card")
ActiveSheet.Name = ShtNam
RwsCnt = Application.ActiveWorkbook.Worksheets("Card").Range("CardNoPicksHeading").CurrentRegion.Rows.Count
RwsCnt = RwsCnt 'Includes Heading for Heading Row
RwsOfData = "1" & ":" & RwsCnt
Set PicksdataRange = Application.ActiveWorkbook.Worksheets("Card").Range("CardAllCardDataRng").Rows(RwsOfData)
'code to execute if sheet exists
PicksdataRange.Copy 'Destination:=Sheets(ShtNam).Range("a1")
'paste values
Sheets(ShtNam).Range("A1").PasteSpecial Paste:=xlValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
'paste formats
Sheets(ShtNam).Range("A1").PasteSpecial Paste:=xlFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Rows(1).RowHeight = Application.ActiveWorkbook.Worksheets("Card").Range("CardAllCardData").RowHeight
For Each col In PicksdataRange.EntireColumn
I = I + 1
Columns(I).ColumnWidth = col.ColumnWidth
Next
Range("A2").Select
Application.ActiveWorkbook.Worksheets("Card").Select
Application.ActiveWorkbook.Worksheets("Card").Activate
Application.ScreenUpdating = True
'Application.ActiveWorkbook.Worksheets("Card").Select = False
Range("A5").Select
End Sub
Thanks in advance
Sub CopyAllCardData()
CurWeekNo = Application.ActiveWorkbook.Worksheets("Card").Range("CardWeek").Rows(2).Value
ShtNam = "Week" & CurWeekNo
On Error GoTo EndMacro
If ActiveWorkbook.Worksheets(ShtNam).Name <> "" Then
MsgBox "WorkSheet " & ShtNam & " Already Exist, must delete it!"
Exit Sub
End If
EndMacro:
Application.ScreenUpdating = False
Worksheets.Add After:=Worksheets("Card")
ActiveSheet.Name = ShtNam
RwsCnt = Application.ActiveWorkbook.Worksheets("Card").Range("CardNoPicksHeading").CurrentRegion.Rows.Count
RwsCnt = RwsCnt 'Includes Heading for Heading Row
RwsOfData = "1" & ":" & RwsCnt
Set PicksdataRange = Application.ActiveWorkbook.Worksheets("Card").Range("CardAllCardDataRng").Rows(RwsOfData)
'code to execute if sheet exists
PicksdataRange.Copy 'Destination:=Sheets(ShtNam).Range("a1")
'paste values
Sheets(ShtNam).Range("A1").PasteSpecial Paste:=xlValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
'paste formats
Sheets(ShtNam).Range("A1").PasteSpecial Paste:=xlFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
Rows(1).RowHeight = Application.ActiveWorkbook.Worksheets("Card").Range("CardAllCardData").RowHeight
For Each col In PicksdataRange.EntireColumn
I = I + 1
Columns(I).ColumnWidth = col.ColumnWidth
Next
Range("A2").Select
Application.ActiveWorkbook.Worksheets("Card").Select
Application.ActiveWorkbook.Worksheets("Card").Activate
Application.ScreenUpdating = True
'Application.ActiveWorkbook.Worksheets("Card").Select = False
Range("A5").Select
End Sub