?
Solved

Excel VBA Code

Posted on 2016-09-22
15
Medium Priority
?
73 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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

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 2000 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 21

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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
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 …
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…

771 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