Macro to copy certain data from one workbook into another

  • Thread starter Thread starter Adam
  • Start date Start date
A

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.
 
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
 
Works perfect. Will let you know if I run into any problems. Thank you so much.

Joel said:
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 said:
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.
Click to expand...
Click to expand...
 
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 said:
Works perfect. Will let you know if I run into any problems. Thank you so much.

Joel said:
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 said:
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.
Click to expand...
Click to expand...
Click to expand...
 
Back
Top