Solved

Excle 2007:  How to activate previously opened file and return to macro file to copy and paste data

Posted on 2011-09-07
4
254 Views
Last Modified: 2012-06-27
Hi, I am trying to create a macro file with data in "Sheet1" from which I copy and paste to a file just opened before the macro file.  The process needs to repeat for subsequent files.  The steps are:

1 open file #1
2 open macro file
3 copy data from sheet1
4 paste data to file #1
5. close macro file
Repeat the above process file file #2, #3 and so on

I attempted to run the code below and it worked only for the first file.  Then for file #2 I received error message 1004 pastespecial method of range class failed.  Debug highlight the following line:

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Can you help?
Sub ReplaceData()
    
    Sheets("Sheet1").Range("A1:C32").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    ActiveWindow.ActivatePrevious
    
    Sheets("Data").Select
    ActiveSheet.Unprotect Password:="pw"
    
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    ActiveSheet.Protect Password:="pw"
    
    Workbooks("Macro.xlsm").Close False
        
End Sub

Open in new window

0
Comment
Question by:JCJG
  • 2
  • 2
4 Comments
 
LVL 41

Expert Comment

by:dlmille
ID: 36501129
Ok - I'm assuming you want to select several files that are password protected, unprotect them, then paste data from macro.xlsm into those sheets, closing and saving those sheets, afterward.  Your code doesn't quite do that, and if I follow you, you don't want to close macro.xlsm.

I hope I've interpreted you correctly on this, otherwise should be a slight modification based on your clarification

This app prompts you for a file - can select 1 or many.  When you hit OK after selecting, it opens each file, unprotects the "data" sheet, then pastes the data from "sheet1" of the macro.xlsm spreadsheet into the opened file.  It then reprotects the opened file, saves it, then processes the next file, etc.

Here's the code:
 
Sub ReplaceData()
Dim fSelection As Variant
Dim fNameList() As String
Dim fFound As Boolean
Dim i As Long
Dim outWkb As Workbook
Dim srcWkb As Workbook, srcSheet As Worksheet
Dim srcRng As Range

    Set srcWkb = ThisWorkbook
    Set srcSheet = srcWkb.Sheets("Sheet1")
    Set srcRng = srcSheet.Range("A1:C32")
    
    'prompt for files to process - can select 1 or more
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = Application.ActiveWorkbook.Path
        .Filters.Add fil, "*.xls*", 1
        .Title = "Please choose location for: " & fil
        .Show
        
        For Each fSelection In .SelectedItems
            ReDim Preserve fNameList(i) As String
            fNameList(i) = fSelection
            fFound = True
            i = i + 1
        Next fSelection
    End With
    
    If Not fFound Then Exit Sub 'must have hit cancel, not selecting anything
    
    Application.EnableEvents = False 'to keep the file we're opening from kicking off any macros
    Application.DisplayAlerts = False 'take defaults, no user prompting on file save, etc.
    
    For i = 0 To UBound(fNameList)
        Application.StatusBar = "Processing: " & fNameList(i)
        'On Error Resume Next 'in case there's an error on opening a file, skip it
        Set outWkb = Workbooks.Open(Filename:=fNameList(i), UpdateLinks:=2) 'don't update links on open
        If Not outWkb Is Nothing Then ' successful open of file
            outWkb.Sheets("Data").Unprotect Password:="pw"
            srcRng.Copy
            outWkb.Sheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            outWkb.Sheets("Data").Protect Password:="pw"
            outWkb.Close savechanges:=True
        End If
        
    Next i
    Application.StatusBar = False
    Set outWkb = Nothing
        
End Sub

Open in new window

macro.xlsm
0
 

Author Comment

by:JCJG
ID: 36503836
Thanks, dlmille!  You know exactlly what I was trying to do.  I appreciate your help.  I was trying to read the script and found it more advanced than my level, obviously. :-)

Can you help me with the following:

Line 18: What does "& fil" do?

Line 39 to 44:  If I want to re-use the script for other procedures I assume this is the area where I can make changes, including calling another sub.
0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 36503995
>> Line 18: What does "& fil" do?

& fil completes the text that goes in the little title button (bottom right of the popup).  

.Title "Please choose location for: " & fil  'concatenates the text string, "Please choose..." with the string filter called fil (which has "*.xls*" in it), so you get a title in the button like:

"Please choose location for: *.xls*"

>> Line 39 to 44:  If I want to re-use the script for other procedures I assume this is the area where I can make changes, including calling another sub.

That is correct.  This is where the code goes for every file that was opened as a result of the selection.


Also, I made one error in the code that I just recalled - needing to get events back on!  See the last few lines you need to get in your code update, or replace the entire routine, as follows:

Sub ReplaceData()
Dim fSelection As Variant
Dim fNameList() As String
Dim fFound As Boolean
Dim i As Long
Dim outWkb As Workbook
Dim srcWkb As Workbook, srcSheet As Worksheet
Dim srcRng As Range

    Set srcWkb = ThisWorkbook
    Set srcSheet = srcWkb.Sheets("Sheet1")
    Set srcRng = srcSheet.Range("A1:C32")
    
    'prompt for files to process - can select 1 or more
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = Application.ActiveWorkbook.Path
        .Filters.Add fil, "*.xls*", 1
        .Title = "Please choose location for: " & fil
        .Show
        
        For Each fSelection In .SelectedItems
            ReDim Preserve fNameList(i) As String
            fNameList(i) = fSelection
            fFound = True
            i = i + 1
        Next fSelection
    End With
    
    If Not fFound Then Exit Sub 'must have hit cancel, not selecting anything
    
    Application.EnableEvents = False 'to keep the file we're opening from kicking off any macros
    Application.DisplayAlerts = False 'take defaults, no user prompting on file save, etc.
    
    For i = 0 To UBound(fNameList)
        Application.StatusBar = "Processing: " & fNameList(i)
        'On Error Resume Next 'in case there's an error on opening a file, skip it
        Set outWkb = Workbooks.Open(Filename:=fNameList(i), UpdateLinks:=2) 'don't update links on open
        If Not outWkb Is Nothing Then ' successful open of file
            outWkb.Sheets("Data").Unprotect Password:="pw"
            srcRng.Copy
            outWkb.Sheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
            outWkb.Sheets("Data").Protect Password:="pw"
            outWkb.Close savechanges:=True
        End If
        
    Next i

   'set some things back up
    Application.StatusBar = False
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Set outWkb = Nothing
        
End Sub

Open in new window

Cheers,

Dave
0
 

Author Closing Comment

by:JCJG
ID: 36537523
Thank you very much!
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now