help with copying column between 2 workbooks through vba

[GJB]

Hi all,
I'm currently working on my first excel application and i'm kinda stuc
at the moment. I have a form wich will get imput from the user feedin
it manufactured products and it will spit out the parts used fo
billing. I have an excel sheet setup for this purpose wich includes
template so to speak that wil do the actual conversion. This templat
will be saved to a new file by date. BUT there can be many suc
conversions in 1 day so i need to be able to insert the column with t
data for that bill included in an already saved file. I have a scrip
setup for this purpose wich wil open the file if it exists and insert
a new column where i want it to. My problem at the moment is that
can't figure out how to paste the needed column from the file create
with the macro to the file opened if the filename exists. Below is som
heavily commented code wich should be self explanatory.
I hope that someone can help me because i'm getting a bit crazy fro
this problem

Sincerely,

GJB

Code
-------------------

Public Sub saveprint()

Dim i As String, j As String, k As String
Dim sh As Worksheet 'source sheet
Dim sh1 As Worksheet 'destination sheet
Dim Thiswb As Workbook
Dim Newwb As Workbook
Dim Savedwb As Workbook
Dim varThiswb As String 'current workbook
Dim varNewwb As String 'new workbook
Dim varSavedwb As String 'saved workbook
Dim fPath As String

'\\ path to save files

fPath = "d:\test\"

Application.ScreenUpdating = False

'\\ format variables for use in savinf filenames and path

i = Format(Me.Controls("datum").Text, "mmm")
j = Format(Me.Controls("datum").Text, "dd-mm")
k = Me.Controls("datum").Text

'\\ see if the folder for current mont exists if not create

If Dir(fPath & i, vbDirectory) = "" Then
MkDir (fPath & i)
End If

'\\declare names of workbooks in variables
varThiswb = ThisWorkbook.Name
Set Newwb = Workbooks.Add(1)
varNewwb = ActiveWorkbook.Name

Application.EnableEvents = False

'\\the template wich is already filled out is copied to a new workbook
'\\Range("C1:C120") holds information wich i may need later if a workbook
'\\for current date already exists because it will have to be put in to tha't
'\\workbook

Windows(varThiswb).Activate
Set sh = Blad6
sh.Cells.Copy
Windows(varNewwb).Activate
Set sh1 = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ActiveSheet.Name = "dagoverzicht" & j
sh1.Range("A1").PasteSpecial Paste:=xlValues
sh1.Range("A1").PasteSpecial Paste:=xlFormats
sh1.Range("c1:c120").Copy
Names.Add Name:="totaal", RefersTo:=Range("D1120")

'\\blad1 is useless so delete

Application.DisplayAlerts = False
Sheets("Blad1").Delete
Application.DisplayAlerts = True

'\\ test to see if a file with current date exists ( i save files by date)
'\\ if not save the file
'\\ if so open the saved file find named range totaal and inject a new
'\\ column before that named range. so far so good, but now i have to
'\\ copy range("c1:c120") to that inserted column wich i can't seem to
'\\ get done

If Dir(fPath & i & "\" & k & ".xls") <> "" Then
varSavedwb = fPath & i & "\" & k & ".xls"
Application.Workbooks.Open varSavedwb
Selection.Find(What:="totaal", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.EntireColumn.Select
Selection.Insert Shift:=xlToRight

*'need code to paste sh1.range("c1:c120") into inserted column here*

ActiveWorkbook.Save
Else
ActiveWorkbook.SaveAs Filename:=fPath & i & "\" _
& k & ".xls", FileFormat:=xlNormal, Password:="", _
WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
End If

'\\show filename an print and close document

MsgBox ActiveWorkbook.FullName

ActiveWorkbook.PrintOut Copies:=1

ActiveWorkbook.Close

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

 

[Glen Mettler]

This might need a little tweak but should put on the right path:
< your code>
ActiveCell.EntireColumn.Select
Selection.Insert Shift:=xlToRight
*'need code to paste sh1.range("c1:c120") into inserted column here*

'=========== my code

COL = ActiveCell.Column
Cells(1, COL).Select
Filename = "File Name to open??"
ThisSheet = ActiveWorkbook.ActiveSheet.Name
Set BaseBook = Application.ActiveWorkbook.Name
Set SourceBook = Workbooks.Open(Filename)
SourceTab = SourceBook.Worksheets("Sheet1").Index
Set SourceRange =
SourceBook.Worksheets("Sheets1").Range("C1:C120")
SourceRcount = SourceRange.Rows.Count
Set DestRange = BaseBook.Worksheets(ThisSheet).Cells(1, COL)

SourceRange.Copy DestRange
SourceBook.Close False

Hope this helps

Glen

 

[GJB]

Thanks Glen this works like a charm, but now i've run into anothe
problem wich wich you could maybe help me. Within the folowing piece o
code i'd like to save the formula's for column D, is this possible?

Windows(varThiswb).Activate
Set sh = Blad6
sh.Cells.Copy
Windows(varNewwb).Activate
Set sh1 = Worksheets.Add(After:=Worksheets(Worksheets.Count))
ActiveSheet.Name = "dagoverzicht" & j
sh1.Range("A1").PasteSpecial Paste:=xlValues
sh1.Range("A1").PasteSpecial Paste:=xlFormats
sh1.Range("c1:c120").Copy
Names.Add Name:="totaal", RefersTo:=Range("D1120")

Thanks a lot for the help so far,

Sincerely,

GJ