Solved

Excel VBA Code

Posted on 2016-09-22
15
56 Views
Last Modified: 2016-09-25
I am trying to copy the data from one sheet to another using vba. But it copying and pasting the data with the header. Is there any way it doesn't copy the header just copy the data with the selection and paste it.

Sub Macro1()
'
' Macro1 Macro
'

'
Worksheets("Westpac").AutoFilterMode = False
    Dim Firstrow As Long
    Dim rng As Range
    Dim Lastrow As Long
    Dim i As Integer
    Dim j As Integer
     i = Sheets("Sheet1").Range("o4")
    
    j = 0
    
    Do Until j = i
     
    Sheets("Sh1").Select
    With ActiveSheet
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
 
     
     
     Sheets("Westpac").Select
     With ActiveSheet
    Sheets("Westpac").Range("A1:C1").Select
    Selection.AutoFilter

    .Range("$A$1:$C$1").AutoFilter Field:=1, Criteria1:=Sheets("Sheet1").Range("m3")
    .Range("$A$1:$C$1").AutoFilter Field:=2, Criteria1:=Sheets("Sheet1").Range("n3")
   Sheets("Westpac").UsedRange.SpecialCells(xlCellTypeVisible).Copy
   
       End With
         
    Sheets("Sh1").Select
   
    Cells(Lastrow).Select
    Range("A" & Lastrow).Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        j = j + 1

    Loop
    
End Sub

Open in new window


Thanks
0
Comment
Question by:surah79
  • 7
  • 7
15 Comments
 
LVL 47

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 41811739
Instead of this line....

Sheets("Westpac").UsedRange.SpecialCells(xlCellTypeVisible).Copy

Open in new window


...use this....

Intersect(Range("2:" & Rows.Count), ActiveSheet.AutoFilter.Range).Copy

Open in new window

0
 

Author Comment

by:surah79
ID: 41811745
It didn't copy the data to the sh1
0
 
LVL 47

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 41811757
Your code looks like it's setting the filter on the Westpac sheet filtering columns A and B by the values in Sheet1!M3 and Sheet1!N3 respectively, then copying that data to the end of the data in the Sh1 sheet. Is that correct? I can't see why you are looping.

Perhaps replace this section of your code...

     Sheets("Westpac").Select
     With ActiveSheet
    Sheets("Westpac").Range("A1:C1").Select
    Selection.AutoFilter

    .Range("$A$1:$C$1").AutoFilter Field:=1, Criteria1:=Sheets("Sheet1").Range("m3")
    .Range("$A$1:$C$1").AutoFilter Field:=2, Criteria1:=Sheets("Sheet1").Range("n3")
   Sheets("Westpac").UsedRange.SpecialCells(xlCellTypeVisible).Copy
   
       End With
         
    Sheets("Sh1").Select
   
    Cells(Lastrow).Select
    Range("A" & Lastrow).Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Open in new window


...with this....

     With Sheets("Westpac")
        .Range("A1:C1").AutoFilter
        .Range("$A$1:$C$1").AutoFilter Field:=1, Criteria1:=Sheets("Sheet1").Range("m3")
        .Range("$A$1:$C$1").AutoFilter Field:=2, Criteria1:=Sheets("Sheet1").Range("n3")
        Intersect(.Range("2:" & Rows.Count), .AutoFilter.Range).Copy
    End With
   Worksheets("sh1") .Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues

Open in new window


If that still doesn't copy any data to sh1, then the filters are not returning any results and you'd need to look at that.
0
 

Author Comment

by:surah79
ID: 41811768
I can see the selection but now its not pasting anything at all...I am looping it because as the same data needs to get copied 5- 6 times so that I don't need to repeat the same data copying again and again.
0
 
LVL 47

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 41811770
Are you able to post your workbook?
0
 

Author Comment

by:surah79
ID: 41811776
it also replace the headers also.

Thanks
Copy-of-test-.xlsm
0
 
LVL 47

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 41811783
The only thing I can see it's doing wrong is the LastRow isn't being used correctly. You don't want it to paste at the LastRow, but the next blank row.

Use Macro2 (it's quicker without the Select statements) and replace this line...

    Worksheets("sh1") .Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues

Open in new window


...with this...

    Worksheets("sh1") .Range("A" & Lastrow + 1).PasteSpecial Paste:=xlPasteValues

Open in new window

0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 47

Accepted Solution

by:
Wayne Taylor (webtubbs) earned 500 total points
ID: 41811785
You can also speed it even more by using this macro instead...

Sub CopyFilteredResults()
    
    Worksheets("Westpac").AutoFilterMode = False
    With Sheets("Westpac")
        .Range("A1:C1").AutoFilter
        .Range("$A$1:$C$1").AutoFilter Field:=1, Criteria1:=Sheets("Sheet1").Range("m3")
        .Range("$A$1:$C$1").AutoFilter Field:=2, Criteria1:=Sheets("Sheet1").Range("n3")
        Intersect(.Range("2:" & Rows.Count), .AutoFilter.Range).Copy
    End With
    
    For i = 1 To Worksheets("Sheet1").Range("O4")
        Worksheets("sh1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    Next
    
End Sub

Open in new window

0
 

Author Comment

by:surah79
ID: 41811796
it is also changing the headings in sh1.Is it possible to stop doing that?

Thanks
0
 
LVL 47

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 41811809
It is not changing the headers. It works fine. Are you using the latest macro I posted, or using the linked macro on the shape in Sh1?
0
 

Author Comment

by:surah79
ID: 41811815
thanks a lot all good.
0
 
LVL 17

Expert Comment

by:Roy_Cox
ID: 41811941
Try this
Sub Copy_Data_Only()
    Dim rData As Range
    With Worksheets("Westpac")
        ''/// check for AutoFilter, switch on if necessary
        If Not .AutoFilterMode Then .Range("A1").AutoFilter
        ''/// filter on third column, change as required. Change criteria as necessary
        .Range("A1").AutoFilter Field:=1, Criteria1:=Sheets("Sheet1").Range("m3")
        .Range("A1").AutoFilter Field:=2, Criteria1:=Sheets("Sheet1").Range("n3")
        ''/// clear the destination sheet
        ''///         Sheets("Sh1").Range("A1").CurrentRegion.ClearContents
        ''/// copy filtered rows to sheet 2
        Set rData = .AutoFilter.Range
        ''/// remove header row
        rData.Offset(1, 0).Resize(rData.Rows.Count - 1, _
                                  rData.Columns.Count).Copy Sheets("Sh1").Cells(Rows.Count, 1).End(xlUp).Offset(1)
        ''/// delete copied rows
        ''///         .AutoFilter.Range.Offset(1).EntireRow.Delete
        ''/// remove AutoFilter
        .Range("A1").AutoFilter
    End With

Open in new window

0
 

Author Comment

by:surah79
ID: 41815159
awesome thanks a lot
0
 
LVL 47

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 41815161
Roy, your code fails to copy x number of times as required.

Surah79, if this question has been solved, please accept the appropriate comment/s as answer.
0
 

Author Closing Comment

by:surah79
ID: 41815179
thanks a lot
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Freeze Panes Solution 6 28
change the windows script file to BAT 10 30
Excel printing page management 2 21
tabctrl with page click event 9 7
Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

920 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now