Excel VBA

how do i change this vba code below to copy the data to a sheet named results rather than opening a workbook and copying the results to the sheet in the workbook.

Sub CopyData()
 
Dim ReportWB As Workbook
Dim DestinationWS As Worksheet
Dim LastRow As Range
 
Application.Workbooks.Open Filename:="M:\K REPORTS REDOING\K_Report_Test.xlsm"
 
Set ReportWB = Application.Workbooks(Application.Workbooks.Count)
Set DestinationWS = ReportWB.Worksheets("Data")
 
For Each coy In Array("1", "2", "A", "C")
    With Sheet6
        Set LastRow = DestinationWS.Range("A1048576").End(xlUp).Offset(1)
        .Range("F1").Value = coy
        Sheet9.Cells.Delete
        .Range("A4:Q1000").AdvancedFilter xlFilterCopy, .Range("Q1:Q2"), Sheet9.Range("A1")
        Intersect(Sheet9.UsedRange, Sheet9.Range("2:1048576")).Copy LastRow
 
    End With
Next coy
 
Set LastRow = Nothing
Set DestinationWS = Nothing
Set ReportWB = Nothing
 
End Sub
 
JKCCAsked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
Rory ArchibaldConnect With a Mentor Commented:
Like so:
Sub CopyData()
 
Dim DestinationWS As Worksheet
Dim LastRow As Range
 
Set DestinationWS = Sheets("Results")
 
For Each coy In Array("1", "2", "A", "C")
    With Sheet6
        Set LastRow = DestinationWS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        .Range("F1").Value = coy
        Sheet9.Cells.Delete
        .Range("A4:Q1000").AdvancedFilter xlFilterCopy, .Range("Q1:Q2"), Sheet9.Range("A1")
        Intersect(Sheet9.UsedRange, Sheet9.Range("2:" & .rows.Count)).Copy LastRow
 
    End With
Next coy
 
Set LastRow = Nothing
Set DestinationWS = Nothing
 
End Sub

Open in new window

0
 
JKCCAuthor Commented:
beautiful, thankyou
0
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.

All Courses

From novice to tech pro — start learning today.