Code for copying whole data in auto filter [Solved/Closed]

Report
-
 Jitu -
Hello,





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,

5 replies

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
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.
1
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

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
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
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
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
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
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
Hi Genius,

i really appreciate, you are a true genius.... the code worked.

Thanks Macro Man.

Regards,
Jitu

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!