Adding A Sheet To Multiple Workbooks With A Macro

rockyw

Well-known Member
Joined
Dec 26, 2010
Messages
1,191
I have about 200 workbooks that I would like to add a sheet to. The sheet I want to add is actually a JPEG I scanned and pasted on a new sheet. I named the sheet (Change Over Worksheet) Is there a way to add this sheet to the other 200 workbooks with a macro copying from another workbook with the new sheet added? All the workbooks are in the same folder and sheet 1 are all different in every workbook. I can do this manually one by one but it will take some time. Thanks
 

Some videos you may like

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

ranman256

Well-known Member
Joined
Jun 17, 2014
Messages
1,957
start with the workbook sheet that has the jpg.
paste this code into the VBE macros
this code will open every workbook in the folder given in FixAllFiles(),
then open the next workbook and copy the source sheet (with Jpg) to the target workbook
Code:
Public Sub FixAllFiles()
FixAllFilesInDir "F:\Documents\"
End Sub


Private Sub FixAllFilesInDir(ByVal pvDir)
Dim FSO, oFolder, oFile, oRX
Dim sTxt As String, sFile As String
Dim wbSrc As Workbook, wbTarg As Workbook
On Error GoTo errGetFiles
Set wbSrc = ActiveWorkbook   'source wb with the jpeg.
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(pvDir)
If Right(pvDir, 1) <> "\" Then pvDir = pvDir & "\"
For Each oFile In oFolder.Files
  If InStr(oFile.Name, ".xls") > 0 Then            'import file here
      sFile = oFile
      Workbooks.Open sFile
      Set wbTarg = ActiveWorkbook
      
           'copy the jpg sheet to new workbook
        wbSrc.Activate
        wbSrc.ActiveSheet.Copy Before:=wbTarg.Sheets(1)
        wbTarg.Close True      
  End If
Next
endit:
Set oFile = Nothing
Set oFolder = Nothing
Set FSO = Nothing
MsgBox "Done"
Exit Sub
errGetFiles:
MsgBox Err.Description, , Err
Resume endit
Resume
End Sub
 
Last edited:

rockyw

Well-known Member
Joined
Dec 26, 2010
Messages
1,191
I found this, will it work as written? Thanks

Option ExplicitPublic Sub CopySheetToAllWorkbooksInFolder()
Dim sourceSheet As Worksheet
Dim folder As String, filename As String
Dim destinationWorkbook As Workbook
'Worksheet in active workbook to be copied as a new sheet to the destination woorkbook
Set sourceSheet = ActiveWorkbook.Worksheets("Sheet1")
'Folder containing the destination workbooks
folder = "F:\temp\excel"
filename = Dir(folder & "*.xls", vbNormal)
While Len(filename) <> 0
Debug.Print folder & filename
Set destinationWorkbook = Workbooks.Open(folder & filename)
sourceSheet.Copy before:=destinationWorkbook.Sheets(1)
destinationWorkbook.Close True
filename = Dir() ' Get next matching file
Wend
End Sub
 

rockyw

Well-known Member
Joined
Dec 26, 2010
Messages
1,191
Hey Ranman 256, this works but before I run this on all 200 can this save as macro free without answering Yes each time and can the new see be after the one there now? I know, I'm asking a lot. Thanks
 

rockyw

Well-known Member
Joined
Dec 26, 2010
Messages
1,191
I found the place to edit for after but I didn't get the save as part yet. Thanks
 

Watch MrExcel Video

Forum statistics

Threads
1,123,305
Messages
5,600,867
Members
414,410
Latest member
4610

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top