How to improve my macro

lumia · Jul 31, 2013

Hi,

i am new to VB. i have recorded some macro to automate my excel data and modify this macro. but macro is too long. i have recorded my macro for collect raw data from a specific location and distribute all data to specified 13 persons existing files and refresh the pivot table which is already made in existing file. Please help me to short this macro:

Code:

Private Sub CommandButton14_Click()
Dim rTable As Range
Windows("AutomaterawDATA.xlsm").Activate




Range("A1").AutoFilter Field:=24, Criteria1:="Naveed"
Set rTable = ActiveSheet.AutoFilter.Range
Set rTable = rTable.Resize(rTable.Rows.Count - 1)
     ' Move new range down to start at the fisrt data row. Set rTable = rTable.Offset(1, 0)
    Set rTable = rTable.Offset(0, 0)
    rTable.Select
    Selection.Copy
    ChDir "D:\DAILY REPORT - DATE WISE"
    Workbooks.Open Filename:="D:\DAILY REPORT - DATE WISE\Daily Collection Report-NAVEED.xlsm"
    Sheets("Raw Data").Select
    Range("a1:t10000").ClearContents
    Range("a1").Select
'Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        Windows("AutomaterawDATA.xlsm").Activate
        Selection.Copy
        Windows("Daily Collection Report-NAVEED.xlsm").Activate
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
        Windows("Daily Collection Report-NAVEED.xlsm").Activate
        ActiveWorkbook.RefreshAll
        Sheets("Raw Data").Select
        Range("a1").Select
        If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
        With Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row)
        .Cells(1, 1).Value = 1
        .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
        End With
    ActiveWindow.ActivateNext
    


'8
Windows("AutomaterawDATA.xlsm").Activate
Range("A1").AutoFilter Field:=24, Criteria1:="Manish Serai"


Set rTable = ActiveSheet.AutoFilter.Range
Set rTable = rTable.Resize(rTable.Rows.Count - 1)
   
    Set rTable = rTable.Offset(0, 0)
    rTable.Select
    Selection.Copy
    ChDir "D:\DAILY REPORT - DATE WISE"
    Workbooks.Open Filename:="D:\DAILY REPORT - DATE WISE\Daily Collection Report-Manish Serai.xlsm"
    Sheets("Raw Data").Select
    Range("a1:t10000").ClearContents
    Range("a1").Select


    Windows("AutomaterawDATA.xlsm").Activate
    Selection.Copy
    Windows("Daily Collection Report-Manish Serai.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("Daily Collection Report-Manish Serai.xlsm").Activate
    ActiveWorkbook.RefreshAll
    Sheets("Raw Data").Select
    Range("a1").Select
    If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
 With Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row)
    .Cells(1, 1).Value = 1
    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
  End With
    ActiveWindow.ActivateNext
'9
Windows("AutomaterawDATA.xlsm").Activate
Range("A1").AutoFilter Field:=24, Criteria1:="Nishant Bhalla"


Set rTable = ActiveSheet.AutoFilter.Range
Set rTable = rTable.Resize(rTable.Rows.Count - 1)
   
    Set rTable = rTable.Offset(0, 0)
    rTable.Select
    Selection.Copy
    ChDir "D:\DAILY REPORT - DATE WISE"
    Workbooks.Open Filename:="D:\DAILY REPORT - DATE WISE\Daily Collection Report-Nishant Bhalla.xlsm"
    Sheets("Raw Data").Select
    Range("a1:t10000").ClearContents
    Range("a1").Select
    


    Windows("AutomaterawDATA.xlsm").Activate
    Selection.Copy
    Windows("Daily Collection Report-Nishant Bhalla.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("Daily Collection Report-Nishant Bhalla.xlsm").Activate
    ActiveWorkbook.RefreshAll
    Sheets("Raw Data").Select
    Range("a1").Select
    If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
 With Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row)
    .Cells(1, 1).Value = 1
    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
  End With
    ActiveWindow.ActivateNext
'10
Windows("AutomaterawDATA.xlsm").Activate
Range("A1").AutoFilter Field:=24, Criteria1:="Pallavi B"


Set rTable = ActiveSheet.AutoFilter.Range
Set rTable = rTable.Resize(rTable.Rows.Count - 1)
    
    Set rTable = rTable.Offset(0, 0)
    rTable.Select
    Selection.Copy
    ChDir "D:\DAILY REPORT - DATE WISE"
    Workbooks.Open Filename:="D:\DAILY REPORT - DATE WISE\Daily Collection Report-Pallavi B.xlsm"
    Sheets("Raw Data").Select
    Range("a1:t10000").ClearContents
    Range("a1").Select


    Windows("AutomaterawDATA.xlsm").Activate
    Selection.Copy
    Windows("Daily Collection Report-Pallavi B.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("Daily Collection Report-Pallavi B.xlsm").Activate
    ActiveWorkbook.RefreshAll
    Sheets("Raw Data").Select
    Range("a1").Select
    If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
 With Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row)
    .Cells(1, 1).Value = 1
    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
  End With
    ActiveWindow.ActivateNext
'11
Windows("AutomaterawDATA.xlsm").Activate
Range("A1").AutoFilter Field:=24, Criteria1:="Partha S Roy"


Set rTable = ActiveSheet.AutoFilter.Range
Set rTable = rTable.Resize(rTable.Rows.Count - 1)
    
    Set rTable = rTable.Offset(0, 0)
    rTable.Select
    Selection.Copy
    ChDir "D:\DAILY REPORT - DATE WISE"
    Workbooks.Open Filename:="D:\DAILY REPORT - DATE WISE\Daily Collection Report-Partha S Roy.xlsm"
    Sheets("Raw Data").Select
  Range("a1:t10000").ClearContents
    Range("a1").Select


    Windows("AutomaterawDATA.xlsm").Activate
    Selection.Copy
    Windows("Daily Collection Report-Partha S Roy.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("Daily Collection Report-Partha S Roy.xlsm").Activate
    ActiveWorkbook.RefreshAll
    Sheets("Raw Data").Select
    Range("a1").Select
    If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
 With Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row)
    .Cells(1, 1).Value = 1
    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
  End With
    ActiveWindow.ActivateNext
'12
Windows("AutomaterawDATA.xlsm").Activate
Range("A1").AutoFilter Field:=24, Criteria1:="Susmitha Sam"


Set rTable = ActiveSheet.AutoFilter.Range
Set rTable = rTable.Resize(rTable.Rows.Count - 1)
   
    Set rTable = rTable.Offset(0, 0)
    rTable.Select
    Selection.Copy
    ChDir "D:\DAILY REPORT - DATE WISE"
    Workbooks.Open Filename:="D:\DAILY REPORT - DATE WISE\Daily Collection Report-Susmitha Sam Thomas.xlsm"
    Sheets("Raw Data").Select
    Range("a1:t10000").ClearContents
    Range("a1").Select


    Windows("AutomaterawDATA.xlsm").Activate
    Selection.Copy
    Windows("Daily Collection Report-Susmitha Sam Thomas.xlsm").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Windows("Daily Collection Report-Susmitha Sam Thomas.xlsm").Activate
    ActiveWorkbook.RefreshAll
    Sheets("Raw Data").Select
    Range("a1").Select
    If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
 With Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row)
    .Cells(1, 1).Value = 1
    .DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1, Trend:=False
  End With
    ActiveWindow.ActivateNext
MsgBox "Done!!"
End Sub

How to improve my macro

lumia

New member