Code for copying whole data in auto filter Solved/Closed

Question

Hello, 



Configuration: Windows 2003 / Internet Explorer 6.0

i am using excel 2007. i recorded a macro to copy segregate the data from data tab to there respective tab. based on there programe code, i.e programe code with csp goes to csp tab from data tab. i used auto filter here. first time it runs correctly. but when i increase the number of rows contaning more data it fails.

Kindly help me here how to solve this.

Thanks,

rizvisa1 · Answer

Could you please upload a sample file with sample data AND MACRO on some shared site like https://authentification.site  , http://wikisend.com/  , http://www.editgrid.com  etc and post back here the link to allow better understanding of how it is now and how you foresee.

jitendra · Answer

Hi,

i have uploaded the sample file with data and macro. please find the link below.
https://authentification.site/files/22638479/new_macro_send.xls

let me know if you need more info.

Regards
Jitendra

rizvisa1 · Answer

First concern. when you are pasting the data, on sheets you are not looking into if that sheet already has data or not. I dont know if that would be the case always or not.   


Now the code  


Sub Macro11()  
'  
' Macro1 Macro  
'  
' Keyboard Shortcut: Ctrl+k  
'  
Dim lMaxRows As Long  
Dim iMaxCols As Integer  
Dim sDataDump As String  
Dim myRange As Range  

    sDataDump = "Dart Dump Jan 10"  
      
      
    Sheets(sDataDump).Select  
    lMaxRows = 0  
      
    Cells.Select  
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False  
      
    On Error Resume Next  
      
        lMaxRows = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row  
        iMaxCols = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column  
    On Error GoTo 0  
      
    If lMaxRows < 9 Then Exit Sub  
      
    If (iMaxCols < Cells(1, "J").Column) Then iMaxCols = Cells(1, "J").Column  
      
    Set myRange = Rows("8:" & lMaxRows)  
          
    myRange.AutoFilter  

      
    myRange.AutoFilter Field:=4, Criteria1:="<>"  
    Range(Cells(9, 1), Cells(lMaxRows, iMaxCols)).Copy  
      
    Sheets("Prod_Effort_Jan").Select  
    Range("A2").Select  
    ActiveSheet.Paste  
      
          
    Sheets(sDataDump).Select  
    myRange.AutoFilter Field:=4, Criteria1:="MSP"  
    Range(Cells(9, 1), Cells(lMaxRows, iMaxCols)).Copy  
      
    Sheets("MSP").Select  
    Range("A2").Select  
    Selection.Insert Shift:=xlDown  
      
      
    Sheets(sDataDump).Select  
    myRange.AutoFilter Field:=4, Criteria1:="CSP"  
    Range(Cells(9, 1), Cells(lMaxRows, iMaxCols)).Copy  
      
    Sheets("CSP").Select  
    Range("A2").Select  
    Selection.Insert Shift:=xlDown  
      
      
    Sheets(sDataDump).Select  
    myRange.AutoFilter Field:=4, Criteria1:="IMG"  
    Range(Cells(9, 1), Cells(lMaxRows, iMaxCols)).Copy  
      
    Sheets("IMG").Select  
    Range("A2").Select  
    Selection.Insert Shift:=xlDown  
      
      
    Sheets(sDataDump).Select  
    myRange.AutoFilter Field:=4, Criteria1:="="  
    Range(Cells(9, 1), Cells(lMaxRows, iMaxCols)).Copy  
      
    Sheets("PM and TR").Select  
    Range("A3").Select  
    ActiveSheet.Paste  
      
      
    Sheets(sDataDump).Select  
    Range("A8").Select  
    Application.CutCopyMode = False  
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Set myRange = Nothing

End Sub

Jitu · Answer

Hi,

thank you very much, appreciate the fast response.

I tried the macro, but whole data is not getting pasted.

i have uploaded the file with your macro, please review it.

if data for different module code changes then, it should go to it respective tab. 

https://authentification.site/files/22655581/new_macro_send2.xls

Regardor s,
Jitendra

rizvisa1 · Answer

Not sure why earlier code is behaving on your book like that.

Here is a modified version that works on your sample

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+k
'
Dim lMaxRows As Long
Dim iMaxCols As Integer
Dim sDataDump As String
Dim myRange As Range
Dim lRowsAdd As Long

    sDataDump = "Dart Dump Jan 10"
    
    
    Sheets(sDataDump).Select
    lMaxRows = 0
    
    Cells.Select
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    
    On Error Resume Next
    
        lMaxRows = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        iMaxCols = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    On Error GoTo 0
    
    If lMaxRows < 9 Then Exit Sub
    
    If (iMaxCols < Cells(1, "J").Column) Then iMaxCols = Cells(1, "J").Column
    
    Set myRange = Rows("8:" & lMaxRows)
        
    myRange.AutoFilter

    
    myRange.AutoFilter Field:=4, Criteria1:="<>"
    Range(Cells(9, 1), Cells(lMaxRows, iMaxCols)).Copy
    
    Sheets("Prod_Effort_Jan").Select
    Range("A2").Select
    ActiveSheet.Paste
    
    
    Application.CutCopyMode = False
    Sheets(sDataDump).Select
    myRange.AutoFilter Field:=4, Criteria1:="MSP"
    lRowsAdd = WorksheetFunction.Subtotal(3, Range("A9:A" & lMaxRows))
    
    If (lRowsAdd > 0) Then
        Sheets("MSP").Select
        Rows("2:" & lRowsAdd + 1).Insert Shift:=xlDown
        Range("A2").Select
        
        Sheets(sDataDump).Select
        Range(Cells(9, 1), Cells(lMaxRows, iMaxCols)).Copy
    
        Sheets("MSP").Select
        Range("A2").Select
        ActiveSheet.Paste
    End If
    
    
    Application.CutCopyMode = False
    Sheets(sDataDump).Select
    myRange.AutoFilter Field:=4, Criteria1:="CSP"
    lRowsAdd = WorksheetFunction.Subtotal(3, Range("A9:A" & lMaxRows))
    
    If (lRowsAdd > 0) Then
        Sheets("CSP").Select
        Rows("2:" & lRowsAdd + 1).Insert Shift:=xlDown
        Range("A2").Select
        
        Sheets(sDataDump).Select
        Range(Cells(9, 1), Cells(lMaxRows, iMaxCols)).Copy
    
        Sheets("CSP").Select
        Range("A2").Select
        ActiveSheet.Paste
    End If
    
    
    Application.CutCopyMode = False
    Sheets(sDataDump).Select
    myRange.AutoFilter Field:=4, Criteria1:="IMG"
    lRowsAdd = WorksheetFunction.Subtotal(3, Range("A9:A" & lMaxRows))
    
    If (lRowsAdd > 0) Then
        Sheets("IMG").Select
        Rows("2:" & lRowsAdd + 1).Insert Shift:=xlDown
        Range("A2").Select
        
        Sheets(sDataDump).Select
        Range(Cells(9, 1), Cells(lMaxRows, iMaxCols)).Copy
    
        Sheets("IMG").Select
        Range("A2").Select
        ActiveSheet.Paste
    End If
    
    
    Application.CutCopyMode = False
    Sheets(sDataDump).Select
    Range("D8").Select
    myRange.AutoFilter Field:=4, Criteria1:="="
    Range(Cells(9, 1), Cells(lMaxRows, iMaxCols)).Copy
    
    Sheets("PM and TR").Select
    Range("A3").Select
    ActiveSheet.Paste
    Range("A2").Select
    
    
    Sheets(sDataDump).Select
    Range("A8").Select
    Application.CutCopyMode = False
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
End Sub

Code for copying whole data in auto filter

5 responses

Similar discussions

Subscribe To Our Newsletter!