help with copying column between 2 workbooks through vba

[GJB]

Hi all,

I've been working on my first excel vba project for some time now and so far i've been able to create my code without many problems thanks to this board . But now i have a problem that i can't figure out. I have made a save print function to automatically print and save a workbook. I've got a test in there to see if a filename exists and if it does i have to copy 1 column from the created file in a certain place in the existing file.
The file opens up okay and i can isert the column in the place i want but i can't seem to figure out how to paste the information i want in the newly created column.

I hope someone can help me figure this out.

Thanks in advance,

GJB

Public Sub saveprint()

Dim i As String, j As String, k As String
Dim sh As Worksheet 'bron sheet
Dim sh1 As Worksheet 'doel sheet
Dim Thiswb As Workbook
Dim Newwb As Workbook
Dim Savedwb As Workbook
Dim varThiswb As String 'huidige workbook
Dim varNewwb As String 'nieuwe workbook
Dim varSavedwb As String 'opgeslagen workbook
Dim fPath As String

' Pad naar de keurrapporten
'fPath = "\\Server01\Company\marcel\Skyline versie 3\keurrapporten\"
fPath = "d:\test\"

Application.ScreenUpdating = False

' formatteer variabelen voor gebruik in opslag van bestand
i = Format(Me.Controls("datum").Text, "mmm")
j = Format(Me.Controls("datum").Text, "dd-mm")
k = Me.Controls("datum").Text

' kijk of maand map bestaat zo niet maak aan
If Dir(fPath & i, vbDirectory) = "" Then
    MkDir (fPath & i)
End If

'declareer namen van de workbooks in variabelen
varThiswb = ThisWorkbook.Name
Set Newwb = Workbooks.Add(1)
varNewwb = ActiveWorkbook.Name

Application.EnableEvents = False

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("D1:D120")
            
Application.DisplayAlerts = False
Sheets("Blad1").Delete
Application.DisplayAlerts = True

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

'Laat de bstandsnaam zien en print en sluit het document
MsgBox ActiveWorkbook.FullName

ActiveWorkbook.PrintOut Copies:=1

ActiveWorkbook.Close
    
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

 

[GJB]

anyone ?

 

[Norie]

GJB

I think we need some more information.

It''s always good to include code when posting, but a explanation of what
the code is meant to do, and what it isn't doing, is also helpful.

 

[Richard U]

Try inserting this




ActiveSheet.Range("c1").Select
Selection.PasteSpecial xlValues

 

[GJB]

what do you want to know?
This save print function is coupled to a userform which will get saved an printed.
The form is used to convert manufactured products to its parts which will get billed to the customer.
I have an excel sheet/ template that will convert manufactured products to its parts and this sheet will be copied to a new workbook and then saved by date.
There can be more than 1 such lists which get converted on 1 day and as such will have to be added to the already saved workbook.
I can insert an empty column to the opened file but my problem is that i can't find a way to paste the column to be copied to the inserted column.

Hope this clears things up a bit,

GJB

 

[GJB]

Okay i've commented every step i take in this macro in english (was dutch) so maybe things will make some more sense now. As you can see from the code below by the time i get stuck i have 3 workbooks open, current workbook holding my macro's, a copy of a template held in current workbook for save and the workbook wich wil have to receive the column of data from the 2nd workbook.
I hope someone can help me because it's driving me crazy at the moment.

Sincerely,

GJB

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("D1:D120") 

'\\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