Macro to Copy data from one file and paste into another

Topic

New Reply

I’ve recorded a macro to copy data from one workbook and paste the values into the workbook from which I initiate the macro. In the recorded version, I simply close the source workbook, but if there’s more than one file open the macro may not work as expected.

How do I get the code to return to the target workbook from which the macro is initiated?
The filename in the code ‘ Windows(“OT&TimeApprovalReport_2012-02-24.xlsm”).Activate will change daily.

Here’s what I’ve got so far, between recorded and edited code:

Sub GetTW_Data()
‘ GetTW_Data Macro

‘Opens source file (this filename never changes)
Workbooks.Open Filename:=”\lv10021financeDORDailyPayrolltw_daily.xls”
Windows(“tw_daily.xls”).Activate

‘Selects, then copies data from tw_daily
Range(“a1”).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

‘Return to target workbook
‘ ActiveWorkbook.Close

Range(“G7”).Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues
‘ Windows(“OT&TimeApprovalReport_2012-02-24.xlsm”).Activate
End Sub

Reply | Quote

Replies

At the the beginning of your Macro, grab the full path of whichever workbook which is running the code as follows:

ActiveWorkbookPath = ThisWorkbook.Path & “” & ThisWorkbook.Name

Than, at the end, substitute ActiveWorkbookPath for the filename in your last Activate statement.

Reply | Quote

Create a variable as type Workbook: [noparse]Dim wkbkCurrent as Workbook[/noparse].
Add a line at the start of your code: [noparse] Set wkbkCurrent = ActiveWorkbook[/noparse].
Add a line before you select the target cell: [noparse]wkbkCurrent.Activate[/noparse].
After you close the copied FROM workbook add a line: [noparse]Set wkbkCurrent = Nothing[/noparse]. :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

was not sure if I should start a new thread or not, suppose I will see if anyone answers this! my problem is similar, except I need to copy all data from current workbook/worksheet to one the user selects.

here is my code, only problem I am having as of now is that it opens the selected workbook, and stops running code.

this is making me nuts, I have done this a lot before, but it has been at least 2 years and I cannot find the old code! errgg!! I don’t remember it being that big of a deal!!

Code:

Public Sub SaveSheets(sName As String)
    Dim sh As Worksheet
    Dim wbDest As Workbook
    Dim wbSource As Workbook
    Dim s As String
    Dim fd As FileDialog
    Dim scmdName As String
 
    If sName Like “*Tech*” Then
        scmdName = “cmdSaveTech”
    Else
        scmdName = “cmdSaveCost”
    End If
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd
        .AllowMultiSelect = False
        .Title = “Choose file to save Worksheet in…”
        If .Show = -1 Then
            s = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    ‘Set the object variable to Nothing.
    Set fd = Nothing
    Application.ScreenUpdating = False
    
    Set wbSource = Application.ActiveWorkbook             
    Set wbDest = Workbooks.Open(s)  <<<<——————-STOPS HERE
    wbSource.Activate
    wbSource.Worksheets(sName).Cells.Copy
    wbDest.Sheets.Add After:=ActiveSheet
    wbDest.ActiveSheet.Paste
    wbDest.ActiveSheet.Name = sName
    wbSource.Application.CutCopyMode = False
    With wbDest.Worksheets(sName).Rows("7:12").Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    wbDest.Worksheets(sName).Range("D7:G12").Copy
    wbDest.Worksheets(sName).Range("D7:G12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    wbDest.Worksheets(sName).Shapes.Range(Array(scmdName)).Delete
   Application.DisplayAlerts = False
   With wbDest
       .Save
       .Close
   End With
    
End Sub

Reply | Quote

Hi

Further to the other answers, here’s my version:

Sub GetTW_Data()

ThisWorkbook.Activate ‘start in THIS workbook
Sheets(1).Select ‘switch to data import sheet

‘Opens source file (this filename never changes)
Workbooks.Open Filename:=”\lv10021financeDORDailyPayrolltw_daily.xls“, ReadOnly:=True

Workbooks(“tw_daily.xls”).Activate ‘switch to source workbook
Sheets(1).Select ‘switch to source data sheet
[a1].CurrentRegion.Copy ‘Copy data to clipboard

ThisWorkbook.Activate ‘Return to THIS workbook

[G7].PasteSpecial Paste:=xlPasteValues ‘paste data to import start cell
[a1].select ‘cancels highlighted paste region

Workbooks(“tw_daily.xls”).Close ‘close source data workbook

End Sub

‘RZ notes:
I always prefer to start my macro to specifically begin in a known location, i.e. when I’m on a specified sheet in a specified workbook i.e. generally the workbook that actually contains the code that is running.
You can adjust Sheets(1) to a named sheet as required, in both files.

Your previous code either assumes that the source data file only has one sheet in it or will always be saved when on the ‘correct’ data sheet.

I prefer opening a source datafile in ReadOnly mode, since this won’t interfere with another User currently working with the same file, and you don’t need to bother with warning messages telling you this.

Also, when I’m ‘pasting’ in data from another workbook, I prefer to clear the import area first. This way, if you run the macro again later and there is now ‘less’ data in the source file, you won’t be left with any ‘remnants’ from a previous import.

zeddy

Reply | Quote

Hi

Further to my previous post, in my ‘original’ code, my code comments are aligned up to a tab stop, but don’t retain this when I post here. Also, the Workbooks.Open line is all on one line, not wrapped.

zeddy

Reply | Quote

Hi

Further to my previous post, in my ‘original’ code, my code comments are aligned up to a tab stop, but don’t retain this when I post here. Also, the Workbooks.Open line is all on one line, not wrapped.

zeddy

Zeddy,

When you post code surround it with [noparse]

Code:

 your code here 

[/noparse] tags. It will hold the indention and also make it easy for the reader to select & copy the code. :cheers:

Note: the tags will not show up in your post, I’ve surrounded them with other tags to keep them from being interpreted.

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

I found your post extreamly helpful and solved almost all my challenges as they were very similiar except I’m using word.

below is my code and unfortunatly it isnt working as it is getting stuck at “Selection.EndKey Unit:=wdLine”

ThisDocument.Activate ‘start in THIS Document
‘Opens source file (this filename never changes)
Application.Documents.Open FileName:=”S:ARRANGEMENT FILES Secretarial Masters FILE START-UPOld Arrangement Filepart 2 NEW MASTER – Arrangement File.docx”, ReadOnly:=True
Documents(“S:ARRANGEMENT FILES Secretarial Masters FILE START-UPOld Arrangement Filepart 2 NEW MASTER – Arrangement File.docx”).Activate ‘switch to source file
Selection.WholeStory
Selection.Copy ‘Copy data to clipboard
ActiveWindow.Close
ThisDocument.Activate ‘Return to THIS Document
Selection.EndKey Unit:=wdLine
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Documents(“S:ARRANGEMENT FILES Secretarial Masters FILE START-UPOld Arrangement Filepart 2 NEW MASTER – Arrangement File.docx”).Close

Reply | Quote

Thanks Zeddy. Your code works great.

Reply | Quote

Hi RG

Thanks for letting me know how to do that.
Now what about those lovely jpg images and other stuff I see in replies.
Do you just copy them and paste them into the ‘quick reply’ panel??

zeddy

Reply | Quote

Hi RG

Thanks for letting me know how to do that.
Now what about those lovely jpg images and other stuff I see in replies.
Do you just copy them and paste them into the ‘quick reply’ panel??

zeddy

Zeddy,

Sorry no cut & paste. What you do is have the file saved on your disk then position your cursor where you want the graphic then click the icon that looks like a picture frame 3rd from right. You’ll get a browse button and you just find the file and click the Upload button. There is another way to do it via the Go Advanced button then scroll down to Manage Attachments button. This will let you attach sample files like .xls etc. and also graphics but they will all be at the bottom of your post rather than interspersed. :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

It is a syntax issue – see here: http://msdn.microsoft.com/en-us/library/office/ff195593.aspx

Having said that, you really need to post this in the Word forum as you are dealing with Word-specific VBA matters: http://windowssecrets.com/forums/forumdisplay//20-Word-Processing

Reply | Quote

was not sure if I should start a new thread or not

alfaista,

Since the OPs issue is not 100% resolved, this would be considered “hijacking” the post. Perhaps one of the moderators may advise the best course of action. If moved, maybe this solution can be moved along with it. I revised your code that will open the destination workbook in a much cleaner fashion. The code runs through nicely up to the line:

wbDest.Worksheets(sName).Shapes.Range(Array(scmdName)).Delete

which refers to an object in your workbook that I do not have enough information to continue with but well past the line of code you stated was problematic..

HTH,
Maud

Code:

Public Sub SaveSheets(sName As String)
Application.ScreenUpdating = False
[COLOR=”#008000″]’————————————-
‘DECLARE AND SET VARIABLES[/COLOR]
    Dim sh As Worksheet
    Dim wbDest As Workbook
    Dim wbSource As Workbook
    Dim s As String
    Dim scmdName As String
    Set wbSource = ThisWorkbook
[COLOR=”#008000″]’————————————-
‘DETERMINE SHAPE NAME BASED ON PASSED PARAMETER[/COLOR]
    If sName Like “*Tech*” Then
        scmdName = “cmdSaveTech”
    Else
        scmdName = “cmdSaveCost”
    End If
[COLOR=”#008000″]’————————————–
‘GET DESTINATION FILE[/COLOR]
    On Error Resume Next
    ChDir (Path)
    s = Application.GetOpenFilename _
        (Title:=”Choose file to save Worksheet in…”, _
        FileFilter:=”Xlsx Files *.xlsx (*.xlsx),”)
    If s = “False” Then
        Exit Sub
    Else
        Workbooks.Open Filename:=s  ‘OPEN THE DESIRED FILE
    ChDir (OldDir)
    End If
    On Error GoTo 0
[COLOR=”#008000″]’————————————–
‘COPY SOURCEFILE SHEET TO DESTINATION WORKBOOK[/COLOR]
    Set wbDest = Application.ActiveWorkbook
    wbSource.Activate
    wbSource.Worksheets(sName).Cells.Copy
    wbDest.Sheets.Add After:=ActiveSheet
    wbDest.ActiveSheet.Paste
    wbDest.ActiveSheet.Name = sName
    wbSource.Application.CutCopyMode = False
[COLOR=”#008000″]’————————————–
‘CONTINUE WITH REST OF CODE[/COLOR]
    With wbDest.Worksheets(sName).Rows(“7:12”).Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = “”
        .ErrorTitle = “”
        .InputMessage = “”
        .ErrorMessage = “”
        .ShowInput = True
        .ShowError = True
    End With
    wbDest.Worksheets(sName).Range(“D7:G12”).Copy
    wbDest.Worksheets(sName).Range(“D7:G12”).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    wbDest.Worksheets(sName).Shapes.Range(Array(scmdName)).Delete
    Application.DisplayAlerts = False
    With wbDest
       .Save
       .Close
    End With
    Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

My arms are extended for a hand slapping if I should not have responded but I couldn’t help myself.

Reply | Quote

Hi,Friends

First, I am a new member at here..
I need you help for solve my task in excel.
My problem was
i. How the data in sheet 1 could be transferred
to sheet 2 ? ( as example 2: complete )

If we refer to the EXAMPLE 2:COMPLETE, students data
can be printed by simply selecting their name.

I hope that (EXAMPLE 1:MY ASSIGNMENT) has a functional
just like EXAMPLE 2:COMPLETE.

I attach a copy of the data for refrence in resolving my problem.

Thank You.. HESSA 40456-Screenshot_2015-05-03-17-12-13

Reply | Quote

Hi Nur

Welcome to the Lounge!

From my limited Malaysian, see my attached file..
Click dropdown to select name.
Marks and Grade are returned for selected person.
I added missing item PI.

zeddy

Reply | Quote

Thank you Zeddy.

I’ve got one question….. refer to Sekolah Bestari data.
Can the total overall score changed automatically( Total Overall Score = M.K )
i. When students take B.A subject ( T.O.S/M.K = 900 marks )
ii.When students do not take B.A subject (T.O.S/M.K = 800 marks)

The above situation ( T.O.S/M.K changed ) are needed without having to change the formula/function =W16/900*100 or =W16/800*100.

The function is suitable for amount of students that many ( more than 50 students ). I was expecting to be shown the steps to develop the function (T.O.S/M.K changed )… Thank you

Reply | Quote

Hi Nur

I have added a formula in cell [X15] to check whether the BA cell in column is empty:

Code:

=IF(U15="",W15/800*100,W15/900*100)

If the BA cell is empty, it uses W15/800*100
If BA is NOT empty, then it uses W15/900*100

see updated file attached.

zeddy
see a

Reply | Quote

Thanks Zeddy because helped me in developing the scoring system in my school. Thank you once again.

Reply | Quote

=w15/if(u15=””,800,900)*100

Reply | Quote

Hi Don

Your logic is impeccable.
Your formula is shorter.
Hope you are fully recovered.

zeddy

Reply | Quote