Changes In Macro

[Rafay Ahmed]

Hi All,
Attached is the Code, Where I have issues in the Last part when the statement copies to Macro Workbook, "Bnk Stmnt" tab, the copied cells don't go to the last cells to paste the selected statement.
Thanks

Sub COPYtoBNKSTMNT()
'
' COPYtoBNKSTMNT Macro
'
'
  Columns("A:A").Select
  Selection.Insert Shift:=xlToRight
  Range("A1").Select
  ActiveCell.FormulaR1C1 = "No"
  Range("A2").Select
  ActiveCell.FormulaR1C1 = "1"
  Range("A3").Select
  ActiveCell.FormulaR1C1 = "2"
  Range("A2:A3").Select
  Selection.AutoFill Destination:=Range("A2:A15"), Type:=xlFillSeries
  Range("A2:A15").Select
  Range("A1").Select
  Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
  Selection.AutoFilter
  ActiveWorkbook.Worksheets("xyz").AutoFilter.Sort.SortFields. _
  Clear
  ActiveWorkbook.Worksheets("xyz").AutoFilter.Sort.SortFields. _
  Add Key:=Range("A1:A15"), SortOn:=xlSortOnValues, Order:=xlDescending, _
  DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("xyz").AutoFilter.Sort
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  Selection.Copy
  Windows("Macro Workbook.xlsx").Activate
  Sheets("Bnk Stmnt").Select
  ActiveSheet.Paste
End Sub

 

[Hui]

Sub COPYtoBNKSTMNT()
'' COPYtoBNKSTMNT Macro''  Columns("A:A").Select
  Selection.Insert Shift:=xlToRight
  Range("A1").Select
  ActiveCell.FormulaR1C1 = "No"
  Range("A2").Select
  ActiveCell.FormulaR1C1 = "1"
  Range("A3").Select
  ActiveCell.FormulaR1C1 = "2"
  Range("A2:A3").Select
  Selection.AutoFill Destination:=Range("A2:A15"), Type:=xlFillSeries
  Range("A2:A15").Select
  Range("A1").Select
  Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
  Selection.AutoFilter
  ActiveWorkbook.Worksheets("xyz").AutoFilter.Sort.SortFields. _
  Clear
  ActiveWorkbook.Worksheets("xyz").AutoFilter.Sort.SortFields. _
  Add Key:=Range("A1:A15"), SortOn:=xlSortOnValues, Order:=xlDescending, _
  DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("xyz").AutoFilter.Sort
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  Selection.Copy
  Windows("Macro Workbook.xlsx").Activate
  Sheets("Bnk Stmnt").Select
  'ActiveSheet.Paste
lr = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("A" & CStr(lr + 1)).PasteSpecial Paste:=xlPasteValues
End Sub

 

[Rafay Ahmed]

Thanks Hui, Its a recorded Macro can this be improved anyway?

 

[Hui]

Have a look at:

Sub COPYtoBNKSTMNT()
' COPYtoBNKSTMNT Macro

  Columns("A:A").Insert Shift:=xlToRight
  Range("A1:A3") = Application.Transpose(Array("No", 1, 2)) 
  Range("A2:A3").AutoFill Destination:=Range("A2:A15"), Type:=xlFillSeries

  Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select
  Selection.AutoFilter
  ActiveWorkbook.Worksheets("xyz").AutoFilter.Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("xyz").AutoFilter.Sort.SortFields.Add _
  Key:=Range("A1:A15"), _
  SortOn:=xlSortOnValues, _
  Order:=xlDescending, _
  DataOption:=xlSortNormal

  With ActiveWorkbook.Worksheets("xyz").AutoFilter.Sort
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  Selection.Copy

  Windows("Macro Workbook.xlsx").Activate
  Sheets("Bnk Stmnt").Select
  lr = Range("A" & Rows.Count).End(xlUp).Row
  ActiveSheet.Range("A" & CStr(lr + 1)).PasteSpecial Paste:=xlPasteValues

End Sub