VBA Code:
Sub Manpower()
Dim lastRow As Long
Dim Wrkb1 As Workbook
Dim Wrkb2 As Workbook
lastRow = Worksheets("Manpower Details").Range("C" & Rows.Count).End(xlUp).Row
Set Wrkb1 = Workbooks.Open("D:\DU\MIS.xlsm")
Sheets("Manpower").Select
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False 'ActiveSheet.Range("A1").AutoFilter ---> Turn On Autofilter
End If
'On Error Resume Next
'Dim Visible_cells As Long
ActiveSheet.Range("A:D").AutoFilter Field:=1, Criteria1:="ACADEMIC"
'Visible_cells = Range("A:E").SpecialCells(xlCellTypeVisible).Cells.Count [I]'Here trying to not to copy if filtered range has no data[/I]
'counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
'If counter > 1 Then
If Range("A:E" & lastRow).SpecialCells(xlCellTypeVisible).Count > 1 Then
With ActiveSheet.AutoFilter.Range
.Offset(1, 0).Resize(.Rows.Count - 1).Copy
End With
Workbooks("Academic").Worksheets("Manpower Details").Activate
Call PasteM
Call mM
'Call lastM
Else
ActiveSheet.AutoFilterMode = False
GoTo 0:
End If
0:
End Sub
Sub PasteM()
Workbooks("Academic").Worksheets("Manpower Details").Activate
Range("C" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sub mO() [I]'Here i m trying to fill Row will current month before the pasted data ...i tried many diffrent methods [/I]
Workbooks("Academic").Worksheets("Outsourcing Charges").Activate
Range("B" & Rows.Count).End(xlUp).Offset(1).Select
'ActiveCell.Value = Format(Now(), "Mmm yy")
Dim ws As Worksheet
Dim lastRow As Long
Dim Alastrow As Long
Set ws = ActiveSheet
lastRow = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
Alastrow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
Range("B" & Alastrow).autofill Destination:=Range("B" & Alastrow & ":B" & lastRow)
'lastRow = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
ActiveCell.Copy Destination:=Range("B" & Alastrow & ":B" & lastRow)
ActiveCell.Offset(-1, 0).Activate
Selection.FillDown
End Sub
Sub lastO()
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.FillDown
End Sub