Copying specific columns from one sheet to another

[menajaro]

Hello everyone
I have two sheets has same format and headers.One is "master workbook" and second one is "summary".
What I am wanting to do is copy specific columns from "summary" to same columns in "master workbook" (the columns are A:J,L,R:S,W,Z:AD,AP:CE).
the format should not be wiped ... I have attached a sample workbook
thanks a lot

[Rudi]

Try this:

Code: Select all

Sub CopyColumns()
Dim rgS As Range

    Set rgS = Intersect(Sheet2.Range("A6").CurrentRegion, Sheet2.Range("A6").CurrentRegion.Offset(2))
    Intersect(rgS, Sheet2.Range("A:J,L:L,R:S,W:W,Z:AD,AP:CE")).Copy
    Sheet1.Range("A8").PasteSpecial '(xlPasteValuesAndNumberFormats)
    Application.CutCopyMode = False
    Application.Goto Sheet1.Range("A8")
    
End Sub

[menajaro]

Welcome Mr. Rudi Thank you very much for your kind help
Everything is ok Please sir, I need to copy the same formats as the source ...the same column width and the same row height and the same font and the same font color.
I want to copy all the formats of the row when grabbed into sheet1 ..
Hope it is clear

[Rudi]

When one pastes, the destination will have the same font type, size and styles and the cells will be filled with the same fill colours.
I have updated the macro to copy the column width and row height for the pasted data.

Code: Select all

Sub CopyColumns()
Dim rgS As Range
Dim r As Long

    Set rgS = Intersect(Sheet2.Range("A6").CurrentRegion, Sheet2.Range("A6").CurrentRegion.Offset(2))
    Intersect(rgS, Sheet2.Range("A:J,L:L,R:S,W:W,Z:AD,AP:CE")).Copy
    Sheet1.Range("A8").PasteSpecial xlPasteColumnWidths
    Sheet1.Range("A8").PasteSpecial '(xlPasteValuesAndNumberFormats)
    For r = 1 To rgS.Rows.Count
        Sheet1.Rows(r + 7).RowHeight = rgS.Rows(r).RowHeight
    Next r
    Application.CutCopyMode = False
    Application.Goto Sheet1.Range("A8")
   
End Sub

[menajaro]

Thanks a lot Mr. Rudi ...The last point if possible
I want to be able to copy and paste columns from first cell until last row , Regardless of the start of the data.
Is it possible to achieve that? Thank you very much for helping me

[Rudi]

I assume when you say 'first cell', you mean cell A1?

Try this code.

Code: Select all

Sub CopyColumns()
Dim rgS As Range, rgA As Range
Dim r As Long

    Set rgS = Sheet2.UsedRange
    For Each rgA In Intersect(rgS, Sheet2.Range("A:J,L:L,R:S,W:W,Z:AD,AP:CE")).Areas
        rgA.Copy
        Sheet1.Range(rgA.Address).PasteSpecial xlPasteColumnWidths
        Sheet1.Range(rgA.Address).PasteSpecial '(xlPasteValuesAndNumberFormats)
    Next rgA
    For r = 1 To rgS.Rows.Count
        Sheet1.Rows(r).RowHeight = rgS.Rows(r).RowHeight
    Next r
    Application.CutCopyMode = False
    Application.Goto Sheet1.Range("A8")
   
End Sub

[menajaro]

That's wonderful .. I am so grateful for you Mr. Rudi
Thank you for your time spent on coding this Topic... If possible : I need another request here ..
How can I clear the columns from the master workbook sheet before copying columns and pasting them?
Thanks again.

[menajaro]

can you help me with With this point please?
Thanks in advance.

[StuartR]

I assume that "clear the columns" means clear the data from the cells in those columns, rather than delete the columns entirely.

Add the following line before "Next rgA"

Code: Select all

rgA.ClearContents

[menajaro]

Thanks for your reply Mr. StuartR
It seems I didn't clarify well. So please accept my apologies
I mean clear the data from the cells in those columns... But from master workbook sheet first before copying columns and pasting them.
how should I do it? Thank you for your cooperation in advance

[HansV]

How about

Code: Select all

    Sheet1.Range("A:J,L:L,R:S,W:W,Z:AD,AP:CE").ClearContents

[menajaro]

Worked perfectly! Thanks a lot Mr. Hans
Best and kind regards for all who shared this Topic.