Macro to copy certain columns of data from 3 x worksheets to a 'summary' worksheet

[ajwilltravel]

Hi everyone

Someone created this macro for me a while back and I am attempting to reuse it but because i don't understand the macro, it is not working. I am using office 365 by the way.

So in the attached file, in the 'summary' sheet, I want to click the blue square to copy all the data in columns D, I, B and Z from the 3 x worksheet "CC PO Details", "CB PO Details" and "CS PO Details". All 3 worksheets are the same except "CS PO Details has 2 extra columns of data on the end (but I don't need them in the 'summary').

Further to this I need the macro to filter out all nil values and all "Finished" values in column I in each sheet.

If you step in to the macro "Copy to Summary" you will see the macro is already built. i just don't know how to adjust it to bring in the columns above!

Also I would ideally like blank columns between columns D, I, B and Z - so leave columns A, D, E and F blank in the 'Summary' after the macro has run.

I hope all this makes sense!!

Thanks very much

[Dante Amor]

Also I would ideally like blank columns between columns D, I, B and Z - so leave columns A, D, E and F blank in the 'Summary' after the macro has run.

I didn't understand which columns you want to copy, in which column you want to paste each column and which columns go blank.
But you can adjust the source column and the destination column, I adjusted the macro to copy each column and its destination.

Try the following:

Please Login or Register  to view this content.

[thomglea]

Something to consider when using copy and paste in VBA: if you are only doing it a couple of times, it's viable, but if you start wanting to copy and paste several hundred or even thousands of times, copy and paste will bog down the script to a crawl. The code above will not have that problem, but if you modify it to loop, keep that in mind.

[Sintek]

Please Login or Register  to view this content.

[ajwilltravel]

Thanks so much this did work but it only copied in data from the 1st worksheet 'CC PO Details', not the other 2 'CB PO Details' & 'CS PO Details' - I do need data copied to summary from all 3 (IF there is a value in column I 'Current Mnth Accrual' in each sheet).

i forgot to say earlier too, as I update the data source sheets 'CC PO Details', 'CB PO Details' & 'CS PO Details - and then rerun the macro, I need it to update what was already there (replace it) from when I last ran the macro.

Thanks again - def nearly there!

[ajwilltravel]

Sorry my reply above was meant for Dante Amor. Now I'll try Sintek's Macro then revert back. Cheers

[ajwilltravel]

That worked perfectly Sintek!! Just one last thing - I'm sorry I didn't mention this earlier but as I update the source data source sheets 'CC PO Details', 'CB PO Details' & 'CS PO Details - and then rerun the macro, I need it to update (totally replace) what was already there - from when I last ran the macro. I just tried making changes on your file 'macro 1' (made some of the values in sheet 'CC PO Details' to "Finished" then reran the macro and it looks it copied all the data again underneath the data already in summary (from when I last ran the macro). So I need it to be overwritten each time I run the macro. Sorry I didn't make this clear from the start!

[Sintek]

Add this snippet after the Dim Statement before the Loop

Please Login or Register  to view this content.

[ajwilltravel]

Sorry is this correct? If so unfort it didn't work...


Sub CopytoSummary()

Dim wsS As Worksheet, wsAR As Worksheet, ws As Worksheet
Dim ar As Variant, i As Long, lr As Long
Set wsS = Sheets("Summary")
ar = Array("CC PO Details", "CB PO Details", "CS PO Details")

With Sheets("Summary"): .Rows(2 & ":" & .Rows.Count).Delete: End With[/B][/B]

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

wsS.[A4].CurrentRegion.Offset(1).Clear

For i = 0 To UBound(ar)
Set wsAR = Sheets(ar(i))
lr = wsAR.Range("A" & Rows.Count).End(xlUp).Row
With wsAR.Range("I5:I" & lr)
.AutoFilter 1, Criteria1:="<>Finished", Operator:=xlAnd, Criteria2:="<>0.00"

With .Resize(.Rows.Count - 7)
Union(.Columns("B:B"), .Columns("D:D"), .Columns("Z:Z"), .Columns("AH")).Offset(1, -1).Copy
wsS.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
.AutoFilter
wsS.Columns.AutoFit
End With
End With
Next i

Application.Calculation = xlCalculationAutomatic
Application.CutCopyMode = False
Application.ScreenUpdating = True


End Sub

[Sintek]

Sorry is this correct? If so unfort it didn't work...

That is not the code I supplied...

[ajwilltravel]

Sorry Sintak - that was the old macro that was still in Macro list. Now using your macro J3v16, is this correct? and can i remove the old macro (Copy to Summary)? thanks again

Sub J3v16()
Dim Data, Arr, ws As Worksheet
With Sheets("Summary"): .Rows(2 & ":" & .Rows.Count).Delete: End With
For Each ws In Sheets(Array("CC PO Details", "CB PO Details", "CS PO Details"))
With ws.Range("A6:Z" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row)
Data = Filter(.Parent.Evaluate("Transpose(If((" & .Columns(9).Address & "<>""Finished"")*(" & .Columns(9).Address & ">0),row(1:" & .Rows.Count & ")))"), False, 0)
If UBound(Data) > -1 Then
Arr = Application.Index(.Value, Application.Transpose(Data), Array(4, 9, "", "", "", 2, 26))
Sheets("Summary").Range("B" & Rows.Count).End(xlUp)(2).Resize(IIf(UBound(Data) = 0, 1, UBound(Arr)), 7) = Arr
End If
End With
Next ws
Sheets("Summary").Cells(1).CurrentRegion.Columns(4).Resize(, 3).SpecialCells(2, xlErrors).Value = ""
End Sub

[ajwilltravel]

Deleting this post as everything now seems to be working !!

[ajwilltravel]

Sorry Sintak one last thing! everything seems to be working - however, on occasion I will have a negative value in column I that needs to go through to the summary... current macro does not seem to like negatives. it's only picking up the positive numbers. any way to fix that? ie any value that is not zero? thanks again!

[Sintek]

Please Login or Register  to view this content.