Hi,

I'm looking for a macro to do the following:

Copy columns B, D, G, and J from my currently opened active workbook,
and paste as a new workbook, whose file name excel would prompt the user to
give.

Conditions: The pasted columns when pasted should be next to eachother as if
the unwanted columns were cut and cells shifted over ( A[b]C[D]EF[G]HI[J] =
BDGJ ). The formatting of the new cells should be exact as the formatting
from the previous workbook (same column widths, same colors, etc.)

Please help. Thanks in advance.

Try this code

Sub CreateNewBook()

fileSaveName = Application.GetSaveAsFilename( _
Title:="Get New book filename", _
fileFilter:="Excel Files (*.xls), *.xls")
If fileSaveName = False Then
MsgBox ("Cannot Get filename - Exiting Macro")
Exit Sub
End If


ColArray = Array("B", "D", "G", "J")
DestCol = 1
Set SourceSht = ThisWorkbook.ActiveSheet

Set NewBk = Workbooks.Add(template:=xlWBATWorksheet)
Set NewSht = NewBk.Sheets(1)

With SourceSht
For Each Col In ColArray
.Columns(Col).Copy _
Destination:=NewSht.Columns(DestCol)
DestCol = DestCol + 1
Next Col
End With

NewBk.SaveAs Filename:=fileSaveName


End Sub


"Adam" wrote:

Hi,

I'm looking for a macro to do the following:

Copy columns B, D, G, and J from my currently opened active workbook,
and paste as a new workbook, whose file name excel would prompt the user to
give.

Conditions: The pasted columns when pasted should be next to eachother as if
the unwanted columns were cut and cells shifted over ( A[b]C[D]EF[G]HI[J] =
BDGJ ). The formatting of the new cells should be exact as the formatting
from the previous workbook (same column widths, same colors, etc.)

Please help. Thanks in advance.

Works perfect. Will let you know if I run into any problems. Thank you so much.

"Joel" wrote:

Try this code

Sub CreateNewBook()

fileSaveName = Application.GetSaveAsFilename( _
Title:="Get New book filename", _
fileFilter:="Excel Files (*.xls), *.xls")
If fileSaveName = False Then
MsgBox ("Cannot Get filename - Exiting Macro")
Exit Sub
End If


ColArray = Array("B", "D", "G", "J")
DestCol = 1
Set SourceSht = ThisWorkbook.ActiveSheet

Set NewBk = Workbooks.Add(template:=xlWBATWorksheet)
Set NewSht = NewBk.Sheets(1)

With SourceSht
For Each Col In ColArray
.Columns(Col).Copy _
Destination:=NewSht.Columns(DestCol)
DestCol = DestCol + 1
Next Col
End With

NewBk.SaveAs Filename:=fileSaveName


End Sub


"Adam" wrote:

Hi,

I'm looking for a macro to do the following:

Copy columns B, D, G, and J from my currently opened active workbook,
and paste as a new workbook, whose file name excel would prompt the user to
give.

Conditions: The pasted columns when pasted should be next to eachother as if
the unwanted columns were cut and cells shifted over ( A[b]C[D]EF[G]HI[J] =
BDGJ ). The formatting of the new cells should be exact as the formatting
from the previous workbook (same column widths, same colors, etc.)

Please help. Thanks in advance.

Can the results be appended to the same workbook ?

I have 3 or 4 workbooks from where i need to copy the date and make it as 1


"Adam" wrote:

Works perfect. Will let you know if I run into any problems. Thank you so much.

"Joel" wrote:

Try this code

Sub CreateNewBook()

fileSaveName = Application.GetSaveAsFilename( _
Title:="Get New book filename", _
fileFilter:="Excel Files (*.xls), *.xls")
If fileSaveName = False Then
MsgBox ("Cannot Get filename - Exiting Macro")
Exit Sub
End If


ColArray = Array("B", "D", "G", "J")
DestCol = 1
Set SourceSht = ThisWorkbook.ActiveSheet

Set NewBk = Workbooks.Add(template:=xlWBATWorksheet)
Set NewSht = NewBk.Sheets(1)

With SourceSht
For Each Col In ColArray
.Columns(Col).Copy _
Destination:=NewSht.Columns(DestCol)
DestCol = DestCol + 1
Next Col
End With

NewBk.SaveAs Filename:=fileSaveName


End Sub


"Adam" wrote:

Hi,

I'm looking for a macro to do the following:

Copy columns B, D, G, and J from my currently opened active workbook,
and paste as a new workbook, whose file name excel would prompt the user to
give.

Conditions: The pasted columns when pasted should be next to eachother as if
the unwanted columns were cut and cells shifted over ( A[b]C[D]EF[G]HI[J] =
BDGJ ). The formatting of the new cells should be exact as the formatting
from the previous workbook (same column widths, same colors, etc.)

Please help. Thanks in advance.