Macro to copy certain data from one workbook into another

[Adam]

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 ( AC[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.

 

[Joel]

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]

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

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

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 ( AC[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.

 

[Speedo]

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

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

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

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 ( AC[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.