We help IT Professionals succeed at work.

VBA

I need a vba macro that would copy the first sheets of the 4 differant/seperate worksheet that are located in C:\workbook into the current open worksheet that has already 4 tabs inserted into it. The macro needs to copy the worksheets located in the C drive that were created within the last 1 hour. Because there will be other worksheets with the same name that were created in the past 4-5 hours within the same location (in the C drive).
Also, while the macro copies the sheets, it needs to copy all the content of them into the current open excel document. Experts please help :)
Comment
Watch Question

CERTIFIED EXPERT

Commented:
Hello,
You can record your own macro while doing the above tasks then view its source code and change code to fit your tasks.

-FA

Author

Commented:
Thanks farzad. You are correct but I dont think it would provide me the code that would copy the content of the sheet1 from the first worksheet which is on C drive and copies that to my current open sheet!

Author

Commented:
Plus I need the code to look for the newest excel files created within the last hour for each of the four excel files. Please read my question again.
See if this gets you close to where you need to be.  You'll need to add a reference to the Microsoft Scripting Runtime library.  Plus, this doesn't do any administrative work, like clear data out of the destination workbook, prior to running, etc.  I am running on Windows 7, so my file types appear as I've listed in the XLS constant.  If you are running on another version, you may have to modify this constant.  Another issue is that I don't assume there are only 4 files - it grabs all files with last modified date within the hour.

Option Explicit

Const PATH = "C:\"
Const XLS = "Microsoft Excel Worksheet"

Sub test()
  Dim fs As FileSystemObject
  Dim b As Folder
  Dim c As File
  Dim t As Date
  Dim thiswb As Workbook, wb As Workbook
 
  Set thiswb = ActiveWorkbook
  t = Now()
  Set fs = New FileSystemObject
  Set b = fs.GetFolder(PATH)

  For Each c In b.Files
    If (c.Type = XLS) And (DateDiff("h", c.DateLastModified, t) <= 1) And (c.Name <> ActiveWorkbook.Name) Then
      Set wb = Application.Workbooks.Open(c.Path)
      wb.Worksheets(1).Copy Before:=thiswb.Worksheets(1)
      wb.Close
    End If
  Next c
End Sub

Author

Commented:
Thanks for your comment. Basically there will be always 4 different types of excel files in the drive for example "sample1.xlsx" "sample2.xlsx" "sample3.xlsx" and  "sample4.xlsx" They all have distinct names. But there will be multiple copies of each of these samples in the drive. So, is there a way that code would only copy the whole content of the sheet1 from sample1 (which was added within the last hour) and pasts it into the 1st sheet of the currently open worksheet which is running the macro? And does the same thing with the 1st sheet of sample2, sample3 and 4  to pasts the 1st sheet of each one in order to the 2nd, 3rd and the fourth sheets of the excel file that is running the macro?
Thanks again for your comment. I appreciate your time.
Do you want to keep the current contents of the destination workbook (prior to macro execution), or will the four new sheets completely replace all other content?

Author

Commented:
Exactly, the four new sheets completely replace all other contents because all the  sheets of the destination workbook will be empty. The destination worksheet would have 4 empty sheets like sheet1, sheet2, sheet3 and sheet4.
Okay, so there are a few ways to do this, with slight mods to my prior code.  I chose a given path, but you could modify if you don't like my revised approach.  Since I like using the worksheet COPY function (vs. selecting all the cells in the worksheet itself) to accomplish the copy, I'll stick with that method.  The only code I've added is a little housekeeping code.  You'll see that initially, in the destination workbook, I delete all worksheets but one (a workbook has to have at least one worksheet).  That gets rid of all of the old data except for the first worksheet.  Since, later in the code, I also added logic to name each new worksheet the same name as the source file it was copied from (sans extension - so in your case, after the run, you'll have sheets "sample1", "sample2", "sample3" and "sample4" in the destination workbook), I have to rename the sole remaining worksheet in the workbook to something different, prior to copying in the new data.  You can't have two worksheets named the same in the same workbook.  You'll see that I name it "AAA" via the constant DUMMYNAME - change this to whatever you like.

After the copy, and subsequent naming of the new worksheets, the last remaining step is to delete the worksheet that remained in the workbook when I deleted all but one (pointed to by DUMMYNAME).  There is a little bit of error testing here, just in case no files were found to copy.

You may want to think about adding a few error checks along the way, for example, what if no files were found that fit the criteria for copying?  Do you want to know that, etc.  You may also want to wrap the whole routine in an ON ERROR GOTO and add a quick message in case any errors crop up during the routine.  Just a suggestion - you may feel these aren't really needed.

Hope this helps, and as always, please make sure and fully test for your environment.

================================
Option Explicit

Const PATH = "C:\"
Const XLS = "Microsoft Excel Worksheet"
Const DUMMYNAME = "AAA"

Sub test()
  Dim i As Integer, j As Integer
  Dim sn As String
  Dim fs As FileSystemObject
  Dim b As Folder
  Dim c As File
  Dim t As Date
  Dim thiswb As Workbook, wb As Workbook
 
  Set thiswb = ActiveWorkbook
  t = Now()
  Set fs = New FileSystemObject
  Set b = fs.GetFolder(PATH)
 
  Application.DisplayAlerts = False
  i = thiswb.Worksheets.Count
  While i > 1
    thiswb.Worksheets(i).Delete
    i = i - 1
  Wend
  thiswb.Worksheets(1).Name = DUMMYNAME
  Application.DisplayAlerts = True

  i = 1
  For Each c In b.Files
    If (c.Type = XLS) And (DateDiff("h", c.DateLastModified, t) <= 1) And (c.Name <> ActiveWorkbook.Name) Then
      Set wb = Application.Workbooks.Open(c.PATH)
      wb.Worksheets(1).Copy After:=thiswb.Worksheets(i)
      j = InStr(c.Name, ".")
      If j <> 0 Then
        sn = Left(c.Name, j - 1)
      Else
        sn = c.Name
      End If
      i = i + 1
      thiswb.Worksheets(i).Name = sn
      wb.Close
    End If
  Next c
 
  Application.DisplayAlerts = False
  If thiswb.Worksheets.Count > 1 Then
    thiswb.Worksheets(DUMMYNAME).Delete
  End If
  Application.DisplayAlerts = True
 
  MsgBox "Done"
 
End Sub


Author

Commented:
Thanks. Maybe I havent explained my terminology clearly. Can you please look at the screenshot :)
 File
Have you tried my solution?  Your explanation shouldn't pose a problem for it.  The only thing I'm wondering is how you are managing to get "3 or 4 copies" of the same filename in the same directory.  That's a feat that Windows should be preventing.  And, based on your stated problem, there will only be 4 files created within the last hour - my solution should pick up these four files.  The only other thing I can see is if you don't want the destination worksheets named for the source files.  If not, you can just leave that piece of code out.

The other solution is to hardcode file names "a", "b", "c", and "d" instead of the For Each loop that I have, and instead of doing a worksheets.copy, you select all contents on Sheet1 in the destination, delete those contents, select all contents on sheet1 of file "a', copy, select sheet1 in destination, paste, then on to sheet2 in the destination/file b.

Author

Commented:
When I ran the macro it didnt grab any of the excel files to insert into the sheet1,2,3 or 4. It only renamed the sheet1 to AAA and deleted the rest of the sheets. I need the code to insearch each excel file that is located in C:\a, b, c, and d into the excel file that us running the macro and has 4 sheets inserted to it by default.  I hope this makes it more clear.

Paul
Assuming the files are in "C:\", as shown in my PATH constant, then the files are failing the if check.  There are only two reasons that could be - either their last modified date is over one hour ago, or you need to adjust the constant XLS for how the files are seen by your system.

From your screeshot, it appears that your system is seeing the Excel files as "Microsoft Office E"... (I can't see the rest of the text).  Expand this column - the type column - so that you can see the entire text.  Once you have the entire text ("Microsoft Office Excel Worksheet" maybe?), enter that exact text into the XLS constant in my macro (where I have "Microsoft Excel Worksheet") and re-run to see if it works.  Unfortunately, the FileSystemObject doesn't return a nice "xls" or "xlsx" for the file type.  If this fails, what I can do is adjust the code slightly to parse out the extension on the file and check for that instead of the actual Type property on the file like I've done (maybe I should have done that first, oh well).

Give this a try and let me know.  Sorry you are having problems.

Author

Commented:
Thanks AgeOfEmpires. It worked perfect after changing that Const XLS = "Microsoft Office Excel Worksheet". However it gave me an error after it copied the first excel sheet tab. Please look at the screenshot attached. file
So this tells me that your files names are not valid as excel sheet names.  I was trying to make the output nice for you on the sheet names so you would know which sheet came from which file.  To simplify things, and avoid any necessary parsing/stripping of file names to get then sheet-name compatible, let's resort to good old "Plan B" - name them Sheet1 through Sheet4.  

Comment out the lines starting with j = InStr(c.Name,".") through EndIf - a total of 6 continguous lines.  Then change thiswb.Worksheets(i).Name = sn to thiswb.Worksheets(i).Name = "Sheet" & CStr(i-1) and give it a try.

Author

Commented:
You are the man. It worked perfect. Only one comment.
Those 4 excel files each one are called for example: a1, b1, c1, d1 and the similar files are seperated with numbers. Like a2(created 3 hours ago), and same story for rest of them. But, each of those excel files have an distinct name. So, Im wondering if it is possible to specify whihc excel sheet to be copied to which new created excel tab in the destination file.
For example: Specify a1(whihc was created 5 min ago) go to Sheet1 of the destination file.
Thanks for your help.
Paul
There are actually a myriad of ways of doing this.  However, since I didn't pick that up from your original problem description - the need to make sure a specific file gets copied to a specifically named spreadsheet - my routine is not optimally set up for that.

Not knowing your true filenames complicates things a little (are they very similar, very different, can there be 10 versions of each or 100's of versions, etc), but a quick way of doing it, assuming let's say the first 5 letters of each file name are unique, you can define an 4x2 string array and initialize the elements as such:

MyArray(1,1) = "FileA"
MyArray(1,2) = "Sheet1"
MyArray(2,1) = "FileB"
MyArray(2,2) = "Sheet2"
etc......

Then, again with the assumption that the first 5 characters will uniquely identify a given file, in the For Each loop, you would need to pull off the first 5 characters of each file name (inside of the IF statement), and then search the 1st dimension of the array for a match.  Once matched, you would grab the corresponding sheet name from the array to use as the sheet name instead of my "Sheet" & CStr(i-1) method.  

ex:

...
  For Each c In b.Files
    If (c.Type = XLS) And (DateDiff("h", c.DateLastModified, t) <= 1) And (c.Name <> ActiveWorkbook.Name) Then
      Set wb = Application.Workbooks.Open(c.PATH)
      wb.Worksheets(1).Copy After:=thiswb.Worksheets(i)
      fprefix = left(c.name,5)
      for k = 1 to 4
        if fprefix = MyArray(k,1) then
          sheetname = MyArray(k,2)
        endif
      next k
......
   thiswb.worksheets(i).name = sheetname
         

This introduces a number of other variables that you may need to account for, like what do you do if a match isn't found for the file prefix in the array?

If we were starting from scratch, I would most likely use a dictionary object to hold the lookups since looping through an array isn't as efficient.  You do only have 4 elements though, so it's no big deal.  Also, your particular environment may call for some other adjustments and error checking, but this should get you a long way down the path of getting a particular file into a particular spreadsheet.

Author

Commented:
The files are in this order: first one that needs to go to Sheet 1 of the destination file is called world_FirWorkInOrder_World_ME_6digitnumber.xls. Second that should go to the second  of the destination file is called world_SecWorkInOrder_World_ME_6digitnumber.xls The Third one that should go to the second  of the destination file is called world_FirWorkInOrder_World_IsDone_6digitnumber.xls and the forth excel file is called Las_COWorkInOrder_World_ME__6digitnumber.xls. These are the name of the four excel files.
The 6 digit numbers change so another file with the same name can be created. So the 6 digit numbers get randomly generated to eliminate overwriting the other files.
So, based on this infor, is there anyway to come up with a code that would pick the newest added of each file and copies the content of it into the appropriate sheets of the destination file?

Paul
In the original problem def, it seems that the 4 files to process were created within the last hour and those were the only created in the last hour.  If that's the case, you don't have to worry about grabbing the latest files - my routine will identify them using the datediff function.  If there is more than one version created per hour, but at a predictable rate, just adjust the datediff function accordingly.  If they are produced at different rates (sometimes a batch occurs at 1 min intervals, sometimes it's 45 mins before a batch occurs) then the datediff function will fail.

Since your file names are of the nature that a set number of characters in the prefix will not uniquely identify them (it takes 28 characters to identify the difference between the 2 FirWorkInOrder files and you don't have that many chars in the Las file), you can resort to a simple series of if statements.  Ex:

If left(c.name,29) = "world_FirWorkInOrder_World_ME" then
  sheetname = "Sheet1"
else if left(c.name,33) = "world_FirWorkInOrder_World_IsDone" then
  sheetname = "Sheet3"
etc....

You want to scrap the array.  

Again, this is not the most optimal solution, but we aren't talking about 1000's of lines of code.  If I were writing a solution with complete knowledge of the problem domain up front, there may be a couple of things to do differently, but in the end this should be a valid solution for you.  Hopefully this helps out.

Author

Commented:
Thanks. Can you please verify this code: It gives me an error on "sheetname" saying it is not defined.


Option Explicit

Const PATH = "C:\"
Const XLS = "Microsoft Office Excel Worksheet"
Const DUMMYNAME = "AAA"

Sub test()
  Dim i As Integer, j As Integer
  Dim sn As String
  Dim fs As FileSystemObject
  Dim b As Folder
  Dim c As File
  Dim t As Date
  Dim thiswb As Workbook, wb As Workbook
 
  Set thiswb = ActiveWorkbook
  t = Now()
  Set fs = New FileSystemObject
  Set b = fs.GetFolder(PATH)
 
  Application.DisplayAlerts = False
  i = thiswb.Worksheets.Count
  While i > 1
    thiswb.Worksheets(i).Delete
    i = i - 1
  Wend
  thiswb.Worksheets(1).Name = DUMMYNAME
  Application.DisplayAlerts = True

  i = 1
  For Each c In b.Files
    If (c.Type = XLS) And (DateDiff("h", c.DateLastModified, t) <= 1) And (c.Name <> ActiveWorkbook.Name) Then
      Set wb = Application.Workbooks.Open(c.PATH)
      wb.Worksheets(1).Copy After:=thiswb.Worksheets(i)
     
  If Left(c.Name, 29) = "world_FirWorkInOrder_World_ME" Then
   sheetname = "Sheet1"
    Else
    If Left(c.Name, 33) = "world_FirWorkInOrder_World_IsDone" Then
  sheetname = "Sheet3"
  Else
  If Left(c.Name, 29) = "world_SecWorkInOrder_World_ME" Then
  sheetname = "Sheet2"
   If Left(c.Name, 26) = "Las_COWorkInOrder_World_ME" Then
  sheetname = "Sheet4"
 
       i = i + 1
  thiswb.Worksheets(i).Name = "Sheet" & CStr(i - 1)
      wb.Close
    End If
  Next c
 
 
 
  Application.DisplayAlerts = False
  If thiswb.Worksheets.Count > 1 Then
    thiswb.Worksheets(DUMMYNAME).Delete
  End If
  Application.DisplayAlerts = True
 
  MsgBox "Done"
 
End Sub
With "Option Explicit" (not the default in VBA, but a very good practice), you must explicitly declare every variable used.  Therefore, you need a Dim sheetname as string in your declarations.  Also, just on a quick perusal of the code above, you need to restructure the IF/THEN/ELSE/ENDIF clause you added - it isn't correctly formed.  The general structure should be (using sort of pseudo code instead of real VBA):

IF Cond1 THEN
  Assignment1
ELSEIF Cond2 THEN
  Assigment2
ELSEIF Cond3 THEN
  Assignment3
ELSEIF Cond4 THEN
  Assignment4
ENDIF

Try out that structure and do a debug/compile in the VBA editor to see if you get any syntax errors.
   
I made the above changes to your code and it passed a syntax check.  

If you'll look closely at the IF structure above, and follow the logic, it should become apparent why I brought up the point 2-3 posts ago about the potential need to enhance the code a little for error checking.  What happens if you wind up with a filename that DOESN'T meet one of the 4 checks?  Should it just be ignored?  Do you need to display a message to the user?  Right now, the code will error out because sheetname will not be properly defined.  You seem to have static file name prefixes, and assuming this doesn't change, you'll not see a problem.  However, if a new file name appears, you would need either to add an additional ELSEIF to the above structure to search for that file name, or and a "catch-all" ELSE statement right before the ENDIF statement that would set sheetname to something like sheetname = "NewFileFound" & CStr(i).  If you take the "catch-all" approach, the reason I concatenated the CStr(i) was just in case 2 or more new files were identified in the run, you wouldn't wind up trying to add two or more sheets with the name "NewFileFound".

I certainly hope all of this helps you out.  Again, starting from scratch and being in your environment, the solution would look somewhat different that it does, but that doesn't detract from the validity of the solution above.  If it were a process-intensive task that handled large volumes of data, then a re-engineering of the routine, now that we've uncovered a few other problem domain criteria, might make sense, but in this case, the routine is still simple and will give you what you need.

Author

Commented:
Sorry, im trying to figure it out but I just don't get it!
Can you check this one too. I rechecked my if statements but it doesn't seem to work:


Option Explicit

Const PATH = "C:\"
Const XLS = "Microsoft Office Excel Worksheet"
Const DUMMYNAME = "AAA"

Sub test()
  Dim i As Integer, j As Integer
  Dim sn As String
  Dim fs As FileSystemObject
  Dim b As Folder
  Dim c As File
  Dim t As Date
  Dim thiswb As Workbook, wb As Workbook
 
  Set thiswb = ActiveWorkbook
  t = Now()
  Set fs = New FileSystemObject
  Set b = fs.GetFolder(PATH)
 
  Application.DisplayAlerts = False
  i = thiswb.Worksheets.Count
  While i > 1
    thiswb.Worksheets(i).Delete
    i = i - 1
  Wend
  thiswb.Worksheets(1).Name = DUMMYNAME
  Application.DisplayAlerts = True

  i = 1
  For Each c In b.Files
    If (c.Type = XLS) And (DateDiff("h", c.DateLastModified, t) <= 1) And (c.Name <> ActiveWorkbook.Name) Then
      Set wb = Application.Workbooks.Open(c.PATH)
    End If
        Next c
  If Left(c.Name, 29) = "world_FirWorkInOrder_World_ME" Then
   wb.Worksheets(1).Copy After:=thiswb.Worksheets(1)
   thiswb.Worksheets(1).Name = "Sheet1"
    Else
    If Left(c.Name, 33) = "world_FirWorkInOrder_World_IsDone" Then
    wb.Worksheets(3).Copy After:=thiswb.Worksheets(3)
  thiswb.Worksheets(1).Name = "Sheet3"
  Else
  If Left(c.Name, 29) = "world_SecWorkInOrder_World_ME" Then
  wb.Worksheets(2).Copy After:=thiswb.Worksheets(2)
  thiswb.Worksheets(1).Name = "Sheet2"
   If Left(c.Name, 26) = "Las_COWorkInOrder_World_ME" Then
   wb.Worksheets(4).Copy After:=thiswb.Worksheets(4)
thiswb.Worksheets(1).Name = "Sheet4"

      wb.Close
    End If
 
 
 
  Application.DisplayAlerts = False
  If thiswb.Worksheets.Count > 1 Then
    thiswb.Worksheets(DUMMYNAME).Delete
  End If
  Application.DisplayAlerts = True
 
  MsgBox "Done"
 
End Sub
You changed up the code quite a bit.  What happens if the first file processed begins with "world_FirWorkInOrder)World_IsDone"?  Your restructured logic trys to insert the 3rd worksheet from that file after the 3rd worksheet in the destination file.  Yet if it is the first file processed, there is only one worksheet in the file, so you are going to error out.  Plus, your IF statement is still not formed correctly.

Option Explicit

Const PATH = "C:\"
Const XLS = "Microsoft Excel Worksheet"
Const DUMMYNAME = "AAA"

Sub test()
  Dim i As Integer, j As Integer
  Dim sheetname As String
  Dim fs As FileSystemObject
  Dim b As Folder
  Dim c As File
  Dim t As Date
  Dim thiswb As Workbook, wb As Workbook
 
  Set thiswb = ActiveWorkbook
  t = Now()
  Set fs = New FileSystemObject
  Set b = fs.GetFolder(PATH)
 
  Application.DisplayAlerts = False
  i = thiswb.Worksheets.Count
  While i > 1
    thiswb.Worksheets(i).Delete
    i = i - 1
  Wend
  thiswb.Worksheets(1).Name = DUMMYNAME
  Application.DisplayAlerts = True

  i = 1
  For Each c In b.Files
    If (c.Type = XLS) And (DateDiff("h", c.DateLastModified, t) <= 1) And (c.Name <> ActiveWorkbook.Name) Then
      Set wb = Application.Workbooks.Open(c.PATH)
      wb.Worksheets(1).Copy After:=thiswb.Worksheets(i)
      If Left(c.Name, 29) = "world_FirWorkInOrder_World_ME" Then
        sheetname = "Sheet1"
      ElseIf Left(c.Name, 33) = "world_FirWorkInOrder_World_IsDone" Then
        sheetname = "Sheet3"
      ElseIf Left(c.Name, 29) = "world_SecWorkInOrder_World_ME" Then
        sheetname = "Sheet2"
      ElseIf Left(c.Name, 26) = "Las_COWorkInOrder_World_ME" Then
        sheetname = "Sheet4"
      Else
        sheetname = "NewFileFound" & CStr(i)
      End If
      i = i + 1
      thiswb.Worksheets(i).Name = sheetname
      wb.Close
    End If
  Next c
 
  Application.DisplayAlerts = False
  If thiswb.Worksheets.Count > 1 Then
    thiswb.Worksheets(DUMMYNAME).Delete
  End If
  Application.DisplayAlerts = True
 
  MsgBox "Done"
 
End Sub

Author

Commented:
FANTASTIC. I really appreciate your time on this. You taught me a lot of useful stuff in this discussion.

Author

Commented:
AgeOfEmpires ROCKSSSSSSSSSSSSS!
Thanks.  I am glad I could assist you and it's great that you were able to learn something along the way.  

Explore More ContentExplore courses, solutions, and other research materials related to this topic.