ACTIVESHEET.PASTE not working.

[Guest]

On the code below, the "ActiveSheet.Paste" is not working in either section
of the IF . . . ELSE statement. I've tried recreating that process in
another MACRO and pasting it to this code with no luck.

Any suggestion will be welcomed.

Thank you in advance

Marco

With ActiveSheet.QueryTables.Add(Connection:= _
"FINDER;C:\Documents and Settings\marco.rodas\Application
Data\Microsoft\Queries\IC Trace Table.dqy" _
, Destination:=Range("A1"))
.Name = "Trace Table Query"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With


Yearanalysis = InputBox("What year?", "Year")

CurrentPeriod = InputBox("What period (SINGLE DIGIT 1-9)?", "Current
Period")
If CurrentPeriod = "" Then
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=8, Criteria1:=Yearanalysis
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Sheet2").Select

ActiveSheet.Paste

Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("Sheet1").Select
Application.CutCopyMode = False

Sheets("Sheet2").Select
Range("M1").Select
Selection.Sort Key1:=Range("M1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Subtotal GroupBy:=13, Function:=xlCount, TotalList:=Array(13), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("K:K").ColumnWidth = 14.14
Columns("L:L").ColumnWidth = 17

Else


Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=8, Criteria1:=Yearanalysis
Selection.AutoFilter Field:=9, Criteria1:=CurrentPeriod
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("Sheet3").Select
Range("A1").Select

ActiveSheet.Paste

Cells.EntireColumn.AutoFit
Range("A1").Select
Sheets("Sheet1").Select
Application.CutCopyMode = False

Sheets("Sheet3").Select
Range("M1").Select
Selection.Sort Key1:=Range("M1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Subtotal GroupBy:=13, Function:=xlCount, TotalList:=Array(13), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("K:K").ColumnWidth = 14.14
Columns("L:L").ColumnWidth = 17
End If

 

[Guest]

sheets("Sheet2").activate
not select

 

[Guest]

Made the change and still did not work. It keeps hanging up on 'paste'
command.

Thanks.

 

[okaizawa]

Hi,

check Application.CutCopyMode like:

Selection.Copy
MsgBox Application.CutCopyMode
Sheets("Sheet2").Select
MsgBox Application.CutCopyMode
ActiveSheet.Paste

if the 2nd msgbox shows '0', then selecting 'Sheet2' turns off the
copy mode. for instance,

'Module1
Sub Test()
Sheets("Sheet1").Activate
Range("A1").Copy
'On Error Resume Next
'Application.EnableEvents = False
Sheets("Sheet2").Activate
'Application.EnableEvents = True
'On Error GoTo 0
MsgBox Application.CutCopyMode
End Sub

'Sheet2 module
Private Sub Worksheet_Activate()
Application.MoveAfterReturnDirection = xlDown
End Sub

if so, the comment lines in the above is one of solutions.
or:

Sub Test2()
Dim rngCopy As Range
Sheets("Sheet1").Activate
Range("A1").Select
Set rngCopy = Selection
Sheets("Sheet2").Activate
rngCopy.Copy
ActiveCell.PasteSpecial
End Sub