VBA help - Copy and paste specific columns to new unnamed workbook

[Mchy]

Hi everyone, I am trying to copy specific columns from the active sheet, create a new workbook and paste the specific columns into the new workbook. However, my issue is that I manage to create a new workbook but was unable to copy the columns and paste. I need some help in this, much appreciated. My code is as below

Sub copy columns()
Dim lastrow as long
dim erow as long

Workbooks.add

Last row = activesheet.select - cells(rows.count, 1).end(xlup).row
for I = 1 to lastrow

Activesheet.select.cells(i, 1).copy
erow=sheet1.cells(rows.count, 1).end(xlup).offset(1,0).row

Activesheet.select.paste destination:=worksheets("sheet1").activate.cells(erow,1)

Activesheet.select.cells(i, 2).copy
Activesheet.select.paste destination:=worksheets("sheet1").activate.cells(erow,2)

Activesheet.select.cells(i, 9).copy
Activesheet.select.paste destination:=worksheets("sheet1")activate.cells(erow,3)

Next i

Application.cutcopymode = false
range("A1").select

End sub

 

[kevin9999]

It seems to me that you're trying to copy columns A, B and I (1, 2 & 9) from the active sheet into columns A, B and C in a new workbook? If that's the case, then the following code should give you that.

Option Explicit
Sub CopyColumns()
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = ActiveSheet
    Set wb = Workbooks.Add
    Set ws2 = wb.Sheets(1)
    
    With ws1
        .Columns(1).Copy ws2.Cells(1, 1)
        .Columns(2).Copy ws2.Cells(1, 2)
        .Columns(9).Copy ws2.Cells(1, 3)
    End With
End Sub

 

[Mchy]

It seems to me that you're trying to copy columns A, B and I (1, 2 & 9) from the active sheet into columns A, B and C in a new workbook? If that's the case, then the following code should give you that.

Option Explicit
Sub CopyColumns()
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = ActiveSheet
    Set wb = Workbooks.Add
    Set ws2 = wb.Sheets(1)
   
    With ws1
        .Columns(1).Copy ws2.Cells(1, 1)
        .Columns(2).Copy ws2.Cells(1, 2)
        .Columns(9).Copy ws2.Cells(1, 3)
    End With
End Sub

Hi Kevin, firstly I would like to thank you for assisting me. The code works fine! However, when I run it, the file save screen keeps popping out and I have to keep pressing cancel in order to update the rest of the columns. Is there a way to maneuver this situation?

 

[Mchy]

Hi Kevin, firstly I would like to thank you for assisting me. The code works fine! However, when I run it, the file save screen keeps popping out and I have to keep pressing cancel in order to update the rest of the columns. Is there a way to maneuver this situation?

It seems to me that you're trying to copy columns A, B and I (1, 2 & 9) from the active sheet into columns A, B and C in a new workbook? If that's the case, then the following code should give you that.

Option Explicit
Sub CopyColumns()
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = ActiveSheet
    Set wb = Workbooks.Add
    Set ws2 = wb.Sheets(1)
   
    With ws1
        .Columns(1).Copy ws2.Cells(1, 1)
        .Columns(2).Copy ws2.Cells(1, 2)
        .Columns(9).Copy ws2.Cells(1, 3)
    End With
End Sub

The "Update values" screen keeps popping out

 

[kevin9999]

The issue you describe usually happens when your file has references to other external files (links) which I didn't experience when I tested the code before I posted it. You can try the amended code to see if it fixes the issue, otherwise I can't help without having the actual file itself.

Option Explicit
Sub CopyColumns()
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = ActiveSheet
    Set wb = Workbooks.Add
    Set ws2 = wb.Sheets(1)
    
    Application.DisplayAlerts = 0
    With ws1
        .Columns(1).Copy ws2.Cells(1, 1)
        .Columns(2).Copy ws2.Cells(1, 2)
        .Columns(9).Copy ws2.Cells(1, 3)
    End With
    Application.DisplayAlerts = 1
End Sub

 

[Mchy]

The issue you describe usually happens when your file has references to other external files (links) which I didn't experience when I tested the code before I posted it. You can try the amended code to see if it fixes the issue, otherwise I can't help without having the actual file itself.

Option Explicit
Sub CopyColumns()
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = ActiveSheet
    Set wb = Workbooks.Add
    Set ws2 = wb.Sheets(1)
   
    Application.DisplayAlerts = 0
    With ws1
        .Columns(1).Copy ws2.Cells(1, 1)
        .Columns(2).Copy ws2.Cells(1, 2)
        .Columns(9).Copy ws2.Cells(1, 3)
    End With
    Application.DisplayAlerts = 1
End Sub

Wow, you're awesome! it worked. Can it be pasted as values instead? As the values pasted are in the formula.

 

[kevin9999]

Wow, you're awesome! it worked. Can it be pasted as values instead? As the values pasted are in the formula.

Option Explicit
Sub CopyColumns()
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = ActiveSheet
    Set wb = Workbooks.Add
    Set ws2 = wb.Sheets(1)
    
    Application.DisplayAlerts = 0
    With ws1
        .Columns(1).Copy
        ws2.Cells(1, 1).PasteSpecial xlPasteValues
        .Columns(2).Copy
        ws2.Cells(1, 2).PasteSpecial xlPasteValues
        .Columns(9).Copy
        ws2.Cells(1, 3).PasteSpecial xlPasteValues
        Application.CutCopyMode = 0
    End With
    Application.DisplayAlerts = 1
End Sub

 

[Mchy]

Option Explicit
Sub CopyColumns()
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = ActiveSheet
    Set wb = Workbooks.Add
    Set ws2 = wb.Sheets(1)
   
    Application.DisplayAlerts = 0
    With ws1
        .Columns(1).Copy
        ws2.Cells(1, 1).PasteSpecial xlPasteValues
        .Columns(2).Copy
        ws2.Cells(1, 2).PasteSpecial xlPasteValues
        .Columns(9).Copy
        ws2.Cells(1, 3).PasteSpecial xlPasteValues
        Application.CutCopyMode = 0
    End With
    Application.DisplayAlerts = 1
End Sub

Thank you, is there a way to copy filtered columns? i.e. visible columns instead of the entire column?

 

[kevin9999]

Try this.

Option Explicit
Sub CopyColumns()
    Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = ActiveSheet
    Set wb = Workbooks.Add
    Set ws2 = wb.Sheets(1)
    
    Application.DisplayAlerts = 0
    With ws1
        .Columns(1).SpecialCells(12).Copy
        ws2.Cells(1, 1).PasteSpecial xlPasteValues
        .Columns(2).SpecialCells(12).Copy
        ws2.Cells(1, 2).PasteSpecial xlPasteValues
        .Columns(9).SpecialCells(12).Copy
        ws2.Cells(1, 3).PasteSpecial xlPasteValues
        Application.CutCopyMode = 0
    End With
    Application.DisplayAlerts = 1
End Sub

 

[kevin9999]

Did the code in post #9 work for you?