Hi,
I am receiving excel report from multiple person with same format. Now I want merge or copy that excel workbooks to a single sheet in daily basis without affect exist data in that main excel.
Hi,
I am receiving excel report from multiple person with same format. Now I want merge or copy that excel workbooks to a single sheet in daily basis without affect exist data in that main excel.
Yep, it can be done......However, you need to give us something to work with....Upload a sample file depicting a before & after.
Good Luck...
I don't presume to know what I am doing, however, just like you, I too started somewhere...
One-day, One-problem at a time!!!
If you feel I have helped, please click on the [★ Add Reputation] to left of post window...
Also....Add a comment if you like!!!!
And remember...Mark Thread as Solved...
Excel Forum Rocks!!!
Hi
Kindly find the attached sheets like “mainsheet”, “report sheet1” and “report sheet2”
Report sheet1&2 should come to the mainsheet
Mainsheet.xlsxreport sheet 1.xlsxreport sheet 2.xlsx
hi sintek,
Right, here you go...this will get you started:
Open a folder on your desktop called REPORTS.....Put all your reports received into this folder.
Paste this code into your MainSheet.Workbook as per sample attached.
The code opens the folder and one by one copies the information from the report sheets to your mainSheet.
![]()
Option Explicit Sub ReportCopy() Dim CopyFromPath As String, FileName As String Dim CopyFrom As Workbook, CopyToWb As Workbook, wb As Workbook Dim rngNames As Range, rng As Range Dim lRow As Long, nextrow As Long, r As Long Application.ScreenUpdating = False CopyFromPath = "C:\Users\Sintek\Desktop\Reports\" 'change to your Path Set CopyToWb = Workbooks("MainSheet.xlsm") FileName = Dir(CopyFromPath & "*.xlsx") Do While Len(FileName) > 0 Set wb = Workbooks.Open(CopyFromPath & FileName) With wb.Sheets("Sheet1") lRow = .Cells(Rows.Count, "A").End(xlUp).Row For r = 2 To lRow .Range("A" & r & ":Z" & r).Copy nextrow = CopyToWb.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1 CopyToWb.Sheets("Sheet1").Range("A" & nextrow).PasteSpecial xlPasteAll Next r Application.CutCopyMode = False wb.Close saveChanges:=False End With FileName = Dir Loop Application.ScreenUpdating = True 'ActiveWorkbook.Close saveChanges:=True End Sub
PS....I noticed that you would like to increment the inputs in Column A
Substitute with this code:
![]()
Option Explicit Private Sub CommandButton1_Click() Dim CopyFromPath As String, FileName As String, sNo As Long Dim CopyFrom As Workbook, CopyToWb As Workbook, wb As Workbook Dim rngNames As Range, rng As Range Dim lRow As Long, nextrow As Long, r As Long, lRow2 As Long Application.ScreenUpdating = False CopyFromPath = "C:\Users\Sintek\Desktop\Reports\" Set CopyToWb = Workbooks("Copy of Mainsheet.xlsm") FileName = Dir(CopyFromPath & "*.xlsx") Do While Len(FileName) > 0 Set wb = Workbooks.Open(CopyFromPath & FileName) With wb.Sheets("Sheet1") lRow = .Cells(Rows.Count, "A").End(xlUp).Row For r = 2 To lRow .Range("B" & r & ":Z" & r).Copy nextrow = CopyToWb.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1 CopyToWb.Sheets("Sheet1").Range("B" & nextrow).PasteSpecial xlPasteAll CopyToWb.Sheets("Sheet1").Range("A" & nextrow) = nextrow - 1 Next r Application.CutCopyMode = False wb.Close saveChanges:=False End With FileName = Dir Loop Application.ScreenUpdating = True 'ActiveWorkbook.Close saveChanges:=True End Sub
Last edited by Sintek; 05-10-2017 at 12:47 AM.
as per you code,i have executed code but its not come to main sheet. if possible to make it as on click button process?
See amended file upload and code in post 6
i not able to click the button see the screenshot Screenshot (1).png
Did you do the following:
Open a folder on your desktop called REPORTS.....Put all your reports received into this folder.
Change this line of code to your Path
Change this line of code to your worksheet name![]()
CopyFromPath = "C:\Users\Sintek\Desktop\Reports\"
![]()
Set CopyToWb = Workbooks("Copy of Mainsheet.xlsm")
yes i change the path also but its getting error see this screenshot Screenshot (2).png
You did not change this line
to![]()
Set CopyToWb = Workbooks("Copy of Mainsheet.xlsm")
![]()
Set CopyToWb = Workbooks("Mainsheet.xlsm")
sorry from that and i have updated it. code is successfully but data is not copied.
Use the following Sample files I uploaded to see if it works..Keep the names the same. Other than that there is nothing more I can do....
Put the 2 sample files in your Report Folder
Put MainSheet on your desktop....Remember to change your path
i not able to click the execute button
Works perfectly from my side....
Explian to me what you have done so we can work through this:
Fist I create the folder in desktop name of REPORTS
Then I keep the file in that folder Main Sheet excel and report excel file also
Then I open the mainsheet after placed the code. It not coped in reports sheets
how to run
Like I said...It works perfectly from my side........Only thing i can think of is that your path is incorrect
Did you change your path
use the following sample files i uploaded to see if it works..keep the names the same. Other than that there is nothing more i can do....
Put the 2 sample files in your report folder
put mainsheet on your desktop....remember to change your path
Yes i change my path Dim rngNames As Range, rng As Range
Dim lRow As Long, nextrow As Long, r As Long, lRow2 As Long
Application.ScreenUpdating = False
CopyFromPath = "C:\Users\travelmall\Desktop\REPORTS"
Set CopyToWb = Workbooks("Mainsheet.xlsm")
FileName = Dir(CopyFromPath & "*.xlsx")
Do While Len(FileName) > 0
Set wb = Workbooks.Open(CopyFromPath & FileName)
Are you sure this is correct:
Open the folder called [Reports]![]()
"C:\Users\travelmall\Desktop\REPORTS"
Right click on any of the report files and click properties....See the location
yes its correct Screenshot (3).pngPHP Code:
[ATTACH]517337[/ATTACH]
Then I am at a loss....
This is the result i get after running the code from MainSheet
I have 2 questions that Which version is you are using? & Are you able to click that Execute button?
Note : I am using MSOFFICE 2010 version & I am not able click Execute button.
Just found your problem !!!!!!
![]()
"C:\Users\travelmall\Desktop\REPORTS\"
put the \ or not
2007, yes am able to click the button.....However, when my path is incorrect....Nothing happens
Yes must be there
thanks for your greatest help and if possible to do the daily basis without duplicate
is it possible to protect the main sheet or how to make read-only format????
After the code runs....... delete the files in Reports Folder......This way there will never be duplicates.
Put this code afterbefore![]()
Loop
![]()
Application.ScreenUpdating = True
![]()
On Error Resume Next Kill "C:\Users\travelmall\Desktop\REPORTS\*.xls" On Error GoTo 0
Last edited by Sintek; 05-10-2017 at 05:20 AM.
there is one doubt
First of all....After everything does the code work perfectly?
If so please mark thread as solved and add to reputation....
Ideally it is ime to open a new thread with a new request.is it possible to protect the main sheet or how to make read-only format????
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks