copying from one file to multiple files.

[Suryaprakash]

I have 250 files in Folder One and I have a file named Vikas.xls in Folder Three which is an open file. I wish to copy a range L1:N500 from this open file to all 250 files in Folder One at the same position, that is, L1. Can somebody give me a code to process this operation?

Thanks.

 

[bertie]

For testing save a couple of empty Excel workbooks in a temp folder.

Open Vikas.xls.
Press ALt+F11.
In the Project window on the left hand side double click on the ThisWorkbook module.
Copy and paste the code below.
Press F5 to run.
Check the range has been copied to the temp workbooks.

I have commented each line of the code to explain what is happening.
You will need to edit where highlighted for worksheet names and ranges.

[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Sub[/COLOR] CopyToMultipleWorksheets()
  [COLOR=darkblue]Dim[/COLOR] wb [COLOR=darkblue]As[/COLOR] Workbook
  [COLOR=darkblue]Dim[/COLOR] strPath [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
  [COLOR=darkblue]Dim[/COLOR] strFilename [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
  
  [COLOR=green]'===================================[/COLOR]
  [COLOR=green]'edit here[/COLOR]
  strPath = "[COLOR=Red]c:\temp\folder1\[/COLOR]"
  [COLOR=green]'===================================[/COLOR]
  
  [COLOR=green]'check for end backslash[/COLOR]
  [COLOR=darkblue]If[/COLOR] Right(strPath, 1) <> "\" [COLOR=darkblue]Then[/COLOR] strPath = strPath & "\"
  
  [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] errHandler
  Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
  
  [COLOR=green]'get the first filename[/COLOR]
  strFilename = Dir(strPath & "*.xl*")
  
  [COLOR=green]'loop through all Excel files in the folder[/COLOR]
  [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] strFilename = ""
    
    [COLOR=green]'open the file[/COLOR]
    [COLOR=darkblue]Set[/COLOR] wb = Workbooks.Open(strPath & strFilename)
      
    [COLOR=green]'copy and paste[/COLOR]
    ThisWorkbook.Sheets("[COLOR=Red]Sheet1[/COLOR]").Range("[COLOR=Red]L1:N500[/COLOR]").Copy _
        Destination:=wb.Sheets("[COLOR=Red]Sheet1[/COLOR]").Range("[COLOR=Red]L1[/COLOR]")
    
    [COLOR=green]'close the file[/COLOR]
    wb.Close SaveChanges:=[COLOR=darkblue]True[/COLOR]
    
    [COLOR=green]'get the next file[/COLOR]
    strFilename = Dir()
  [COLOR=darkblue]Loop[/COLOR]
    
errHandler:
  Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
  Application.CutCopyMode = [COLOR=darkblue]False[/COLOR]

[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[Suryaprakash]

Hi Bertie:

Thanks for your code. Sorry, I could not test the code earlier because I was away for a few days. The code is working quite well. The only difficulty I had was to rename first sheet as Sheet1 in each of the destination files because the name of the first sheet was the same as that of the file. Could you give me a small code by which I can rename first sheet in each file in the folder as Sheet1?. All my files have only one sheet and I am using Excel 2000.

Thanks once again for your kind help.

Regards

Suryaprakash

 

[bertie]

If the worlsheet is the first one in each workbook then take out the sheetname and replace it with the number 1.

i.e, edit tihs line in the code.

=====================
I HAVE EDITED THE CODE
=====================

[COLOR=#008000]'copy and paste[/COLOR]
    ThisWorkbook.Sheets[COLOR=black]("Sheet1").[/COLOR][COLOR=black]Range("L1:N500").Copy _[/COLOR]
[COLOR=black]       Destination:=wb.Sheets([COLOR=red]1[/COLOR]).Range("L1")[/COLOR]