VBA - copy paste workbooks from one to the other

[manc]

Good afternoon,

I have the following code:

Sub copypasteworkbook()
Dim x As Workbook
Dim y As Workbook
Dim vals as Variant


'## Open both workbooks first:
Set x = Workbooks.Open(" path to copying book ")
Set y = Workbooks.Open(" path to destination book ")


'Store the value in a variable:
vals = x.Sheets("name of sheet").Range("A1").Value


'Use the variable to assign a value to the other file/sheet:
y.Sheets("sheetname").Range("A1").Value = vals 


'Close x:
x.Close


End Sub

I am looking to make amendments to the code.

Providing that you are working will ROW 1 in 'workbook x':

Set y = Workbooks.Open(" path to destination book ")

Path to destination book is the same each time, but the filename of the destination workbook is not.
The filename of the source workbook is chosen from a drop-down list in cell B1 within 'workbook x'.

'Use the variable to assign a value to the other file/sheet:
y.Sheets("sheetname").Range("A1").Value = vals

Where "sheetname" is the value from the drop-down list in cell B1 within 'workbook x'.

For example purposes, path where B1 data is stored is "C:\Examplefolder"

'Close x:x.Close

Save and close workbook x.

I then want all of the above codes applied to all rows.

Any help/suggestions greatly appreciated.

Best regards
manc

 

[davesexcel]

You can test this as a stand alone code, it will open the workbook in B1 and place the value in the first empty cell in A1.
Change the folder location in the code

Sub Button1_Click()
    Dim wb As Workbook, bk As Workbook, fNm As String, fRng As Range
    Dim ws As Worksheet, sh As Worksheet
    Set wb = ThisWorkbook

    Application.ScreenUpdating = False

    With wb
        Set ws = .Sheets("Sheet1")
        Set fRng = ws.Range("B1")
        fNm = "C:\Users\dmorrison\Downloads\DTestFolder\" & fRng.Value & ".xlsx"
    End With

    Set bk = Workbooks.Open(fNm)
    With bk
        Set sh = .Sheets("Sheet1")
        With sh
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = fRng.Offset(, -1)
        End With
        .Save
        .Close
    End With

End Sub

If you wanted this to me more automated, you could use a worksheet change event, it belongs in the worksheet module.
-
-

You can copy and paste the code in the worksheet module.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bk As Workbook
    Dim sh As Worksheet, fNm As String


    Application.ScreenUpdating = False
    If Target.Count > 1 Then Exit Sub

    If Target.Column = 2 Then
        fNm = "C:\Users\dmorrison\Downloads\DTestFolder\" & Target.Value & ".xlsx"
    End If

    Set bk = Workbooks.Open(fNm)

    With bk
        Set sh = .Sheets("Sheet1")
        With sh
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Target.Offset(, -1)
        End With
        .Save
        .Close
    End With

End Sub

 

[manc]

Hi Dave,

Thanks very much for both options - I wasn't expecting the effort that you made. It is highly appreciated.
I've tried both ways and think option 1 is best for what i need.

However, i have a couple of questions regarding the code.

With wb
        Set ws = .Sheets("Sheet1")
        [COLOR=#ff0000]Set fRng = ws.Range("B1")[/COLOR]
        fNm = "C:\Users\dmorrison\Downloads\DTestFolder\" & fRng.Value & ".xlsx"
    End With

Cell "B1" is not the same each time.
What we are essentially doing is allocating a job number (column A - sequential) against a customer template from the drop-down list in column B.
Once a user has chosen a customer template from the drop-down list in B1, it opens the template and allocates the job number from cell A1 into the newly opened template.
When the next job is ready, a user would then select from cell B2 - template opens automatically, taking the 'job number' from A2 and populating on the newly opened template.

If possible, the user should NOT be able to go back into workbook x and change the value in cell B1 or any row that already have a value in - only blank rows, so that no already 'live' jobs are over-written.

Set bk = Workbooks.Open(fNm)
    With bk
        Set sh = .Sheets("Sheet1")
        With sh
[COLOR=#ff0000]            .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = fRng.Offset(, -1)[/COLOR]
        End With
        .Save
        .Close
    End With

This should be a constant cell, A10 for example.

One last thing... I've tried moving the .Save and .Close from where it currently is in the code, as it should be the first workbook that saves and closes, once the new template has opened, thus leaving it to be worked on - having trouble using the correct syntax though.

Finally, thanks for your time spent so far. Any further advice, greatly appreciated as before.

Best regards
manc