Solved

Excel VBA Code

Posted on 2016-09-22
15
66 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Creating Instructional Tutorials  

For Any Use & On Any Platform

Contextual Guidance at the moment of need helps your employees/users adopt software o& achieve even the most complex tasks instantly. Boost knowledge retention, software adoption & employee engagement with easy solution.

 

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
 
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 20

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

Creating Instructional Tutorials  

For Any Use & On Any Platform

Contextual Guidance at the moment of need helps your employees/users adopt software o& achieve even the most complex tasks instantly. Boost knowledge retention, software adoption & employee engagement with easy solution.

Question has a verified solution.

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

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

717 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