Results 1 to 1 of 1

Thread: How to improve my macro

  1. #1

    Lightbulb How to improve my macro



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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
    Last edited by Zack Barresse; 2013-08-02 at 07:28 AM. Reason: Added CODE tags

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •