fix copy cells macro

I've come across a problem with this macro.

As I requested the macro will add 5 lines to the next free row available in the worksheet. The trouble is that 90% of the time this work sheet will be filtered so that column A on the result_example sheet excludes the blank cells leaving only the names in column A. When I run the macro and there is a filter on column A it is causing less info to be copied over to the destination workhseet.

When there is no filter applied it works fine and all 5 rows and the correct values are copied over as links.

Perhaps a way of getting round this would be for the macro to unfilter column A>>>then run the current code>>> then reapply the filter*

*filter = select all values in column A excluding (blanks)

Perhaps you may know of a more efficient way of doing this.

I've tweaked the current code (see below) so if you could apply the changes to this and re-paste a a snippet of the new code it would be much appreciated.

Option Explicit

Sub NewCode()
''/// the sheet name will need to be changed to actual name used in the final workbook

    If ActiveSheet.Name = "Stakeholder_Actionpoints" Then
        MsgBox "You have the rsults sheet active.", vbCritical, "Error"
        Exit Sub
    End If
    Dim ws As Worksheet
    Dim rToCopy As Range
    Dim lRw As Long
    Dim iX As Integer
    '1. Copy all values (including blank cell values) from the range A14:E18 and paste under the relevant column headings found in sheet Stakeholder_Actionpoints
    Set ws = ActiveSheet
    Set rToCopy = ws.Range(Cells(14, 1), Cells(18, 5))


    With Sheet55
        lRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        rToCopy.Columns(1).Copy
        Application.Goto .Cells(lRw, 2)
        ActiveSheet.Paste Link:=True
        rToCopy.Columns(2).Copy
        Application.Goto .Cells(lRw, 1)
        ActiveSheet.Paste Link:=True
        rToCopy.Columns(3).Copy
        Application.Goto .Cells(lRw, 5)
        ActiveSheet.Paste Link:=True
        rToCopy.Columns(5).Copy
        Application.Goto .Cells(lRw, 3)
        ActiveSheet.Paste Link:=True
        rToCopy.Columns(6).Copy
        Application.Goto .Cells(lRw, 4)
        ActiveSheet.Paste Link:=True

        For iX = 1 To rToCopy.Rows.Count

            .Hyperlinks.Add Anchor:=.Cells(lRw, 6), Address:="", SubAddress:= _
                            "'" & ws.Name & "'!A" & iX + 13, TextToDisplay:=ws.Name

            lRw = lRw + 1

        Next iX
    End With
End Sub

Open in new window


Thanks Mike
EmailIt-macro--1---1---1-.xlsm
mikes6058Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Roy CoxGroup Finance ManagerCommented:
Hi Mike

This should be a simple fix. I just need to change where the filter is being removed.
0
Roy CoxGroup Finance ManagerCommented:
Hopefully, this is what you want.

The code removes the filter on results_example, then copies from the sterling sheet. The filter is then restored on results_example
EmailIt-macro--1---1---1-.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mikes6058Author Commented:
Perfect fix, works just how I wanted it!

Mike
0
mikes6058Author Commented:
I was just wondering if you'd managed to take a look at the date insert issue on the email macro?

Mike
0
Roy CoxGroup Finance ManagerCommented:
Hi Mike

I'll look at that asap, I'm busy today visiting family
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.