Copy from One Workbook to Another

[Becky]

I am trying to automate copying data from one workbook into another
workbook. The source book, and the various sheets and cells within it, will
be different each time. The destination book, however, with only one sheet,
will always be the same.



The user manually opens the source workbook, activates the desired sheet and
selects the cell containing the name of the item he wants. The selected
cell is always in row 3 of the desired column. I need to copy that column
and the column immediately to its right as well as column A and paste the 3
columns into the destination workbook.



I have the following code to get the info regarding the source workbook:



Dim GlazeFile As String

Dim GlazeSheet As String

Dim GlazeCell As String

Dim MyPrintFile As String



'Get the full path and name of the file

GlazeFile = ActiveWorkbook.FullName

'Get the worksheet tab name

GlazeSheet = ActiveSheet.Name

'Get the active cell(s)

GlazeCell = ActiveWindow.RangeSelection.Address



Then I have code which checks to see if the destination file is open and
opens the file if it is not.



'Determine whether destination file is open. If not, open the file.

Dim MyPrintFile As String

MyPrintFile = "Glaze_Print.xls"

On Error Resume Next

x = UCase(Workbooks(MyPrintFile).Name)

If Err = 0 Then

MsgBox MyPrintFile & " is open."

Else

Workbooks.Open "c:\Matts\Glazes\" & MyPrintFile

End If



After hours of searching newsgroups, on-line help, and trying various code,
I can't figure out the code needed to copy the 3 columns of data from the
source book and paste it into the destination book. A recent poster asked a
similar question, but I'm not savvy enough to be able to translate that
answer to my situation.



Would someone help me with this please? Thank you.

Excel 2003 Windows XP



Becky

 

[Don Guillett]

Will the source worksheet, column, and row ALWAYS be the same? If not, are
they known beforehand?
If so, why not have a list of the files in the destination wb and then just
use a double_click macro to get the data, probably withOUT opening. I did
something like this for a client in Switzerland.

 

[Becky]

No, the source workbook will be different each time. There are a number of
them now and additional workbooks will be added over time. Other than
column A, which will always be copied, the other 2 columns to be copied will
be different each time - different workbooks, and different sheets within
the books. (I don't have any control over the number of source workbooks or
the number of sheets in them.)

 

[Don Guillett]

I am going to watch the University of Texas win a football game. I have it
working for a range. I will play with this tomorrow. Who is this for? Send
me more examples to my address below
If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You send a clear explanation of what you want
3. You send before/after examples and expected results.

 

[Becky]

Thank you, Don. I think that I have not been clear in explaining what I
want to do because of my very limited experience with VBA. i.e., I don’t
know how to state the problem and ask the questions properly.



I only need to copy rows 3 through 200 of 3 columns from the source book to
the destination book. I will always copy/paste A3:A200 and will also
copy/paste rows 3 - 200 of two other contiguous columns (these two other
columns will vary each time the macro is used). (The data in the
destination book will then be “prettied up”, irrelevant rows deleted and the
sheet printed. I know how to do the code to re-format, delete the zero
rows, etc. Once the sheet is printed, the workbook will be closed without
saving.)



Can you help me with code just to copy A3:A200 from my source book and paste
it to my destination book using the workbook/worksheet/cell identifying info
as per my initial posting? That would get me started. I’ve tried various
code but get ‘Subscript out of range’ or ‘Type mismatch’.



Thank you again. I hope you enjoy the football game!

 

[Don Guillett]

I repeat my offer to send me your dest file and a couple of source files to
test.

 

[Don Guillett]

'thisworkbook
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target
As Range, Cancel As Boolean)
If Target.Row <> 3 Then Exit Sub
Call CopyColumsToPrintSheetSAS
End Sub
'reg module
Option Explicit
Sub CopyColumsToPrintSheetSAS()
Dim mc As Long
Dim colltr1 As String
Dim colltr2 As String
Dim newname As String

Application.ScreenUpdating = False
mc = ActiveCell.Column
'MsgBox mc
colltr1 = Chr(mc + 64)
colltr2 = Chr(mc + 1 + 64)
'MsgBox colltr2
newname = ActiveCell
Range("a1," & colltr1 & "1:" & colltr2 & "1").EntireColumn.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A2").Select
Columns(1).Columns.AutoFit
ActiveSheet.PrintPreview 'if desired change to printOUT
ActiveWorkbook.SaveAs Filename:=newname & ".xls" 'if desired
ActiveWindow.Close
Range("a1").Select
Application.ScreenUpdating = True
End Sub

 

[Becky]

Thank you very much for your help. Can you help me with one more thing,
please?

How can I change the line which reads: ActiveSheet.PrintPreview so that it
comes up as a regular worksheet instead of a print preview?

Thank you.

 

[Don Guillett]

If you are talking about solution 1 that I sent then just comment out the
line or delete it.
solution1
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target
As Range, Cancel As Boolean)
If Target.Row <> 3 Then Exit Sub
Call CopyColumsToPrintSheetSAS
End Sub
'in a regular module
Option Explicit
Sub CopyColumsToPrintSheetSAS()
Dim mc As Long
Dim colltr1 As String
Dim colltr2 As String
Dim newname As String

Application.ScreenUpdating = False
mc = ActiveCell.Column
'MsgBox mc
colltr1 = Chr(mc + 64)
colltr2 = Chr(mc + 1 + 64)
'MsgBox colltr2
newname = ActiveCell
Range("a1," & colltr1 & "1:" & colltr2 & "1").EntireColumn.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A2").Select
Columns(1).Columns.AutoFit
ActiveSheet.PrintPreview 'if desired change to printOUT
ActiveWorkbook.SaveAs Filename:=newname & ".xls" 'if desired
ActiveWindow.Close
Range("a1").Select
Application.ScreenUpdating = True
End Sub
======
Solution 2 was to NOT make a separate file but to just print the desired
columns

Option Explicit
'SalesAid Software (e-mail address removed)
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target
As Range, Cancel As Boolean)
Dim ac As Long
Dim lc As Long

If ActiveCell.Row <> 3 Then Exit Sub
Application.ScreenUpdating = False
ac = ActiveCell.Column
'MsgBox ac
lc = Cells(3, Columns.Count).End(xlToLeft).Column
If lc = ac Then lc = ac + 2
'MsgBox lc
Columns(ac + 2).Resize(, lc - ac).Hidden = True
'MsgBox ac - 2
If ac - 2 = 0 Then GoTo printit
Columns(2).Resize(, ac - 2).Hidden = True
printit:
ActiveSheet.PrintPreview 'change to printOUT
Columns.Hidden = False
Range("a1").Select
Application.ScreenUpdating = True
End Sub

 

[Becky]

Don,
Thank you for all of your help with this. It's working great now.
Becky