PDA

View Full Version : Copy Sheet From file to workbook, and save it as origin name in different file



OSABBAGH
08-07-2018, 06:44 AM
Hello all,
I'm new to VBA and coding.

Recently this summer i developed a very in depth, workbook project.
The workbook is a book for each day, I have an issue if i upgrade the project with certain macros or modules, all the sheets prior to me updating it do not receive update, and i would have to copy the data from each workbook to the newer version and save it, manually.

Sheet "A" on each woorkbook contains the RAW data of my concern,

Would someone help me develop a code to loop through all the woorkbooks within a file, copy the first sheet "A" to the "new updated workbook", save the workbook as the same file name that the worksheet "a" was copied from.


To simplifiy:

I have workbooks saved under file named C:\Users\osabbagh\Desktop\old
I want to open each workbook in this file, copy only the first sheet called "A" to my new workbook,
Save the "NEW" workbook as the same file name from
C:\Users\osabbagh\Desktop\old
into
C:\Users\osabbagh\Desktop\new
for each workbook found in
C:\Users\osabbagh\Desktop\old

OSABBAGH
08-07-2018, 07:38 AM
Right now i have found a code and edited to suit my needs, the only issue i Have with this is i must select each workbook one by one by running this module below::


Private Sub Import_Data_Into_Current_Workbook_EE()
Dim NEWF As String
Dim SAVENAME As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook
' active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = "&Open"
.InitialFileName = "C:\Users\osabbagh\Desktop\julyo"
.Filters.Clear
.Filters.Add "Excel files (*.xls; *.xlsm; *.xlsx)", "*.xls;*.xlsm;*.xlsx", 1
.Title = "Please Select an input file"
.AllowMultiSelect = False
End With
If Not (Application.FileDialog(msoFileDialogOpen).Show) Then
MsgBox "No File specified!.", vbExclamation, "Cancel has been pressed!"
Exit Sub
Else
customerFilename = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
SAVENAME = ActiveWorkbook.Name
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)
On Error Resume Next
Set srcSht = targetWorkbook.Sheets(sourceSheet.Name)
On Error GoTo 0
If IsEmpty(srcSht) Then
sourceSheet.Copy Before:=targetWorkbook.Sheets(1)
customerWorkbook.Close
Else
MsgBox "Sheet name already there"
Exit Sub
End If
End If
NEWF = "C:\Users\osabbagh\Desktop\newfiles"
Application.Wait Now + TimeValue("00:00:01")
ActiveWorkbook.SaveAs NEWF & SAVENAME
End Sub




How would i go about letting this module run byitself for EACH workbook found in the folder "oldfiles"