Macro to copy cells from worksheet with variable name.

[t0ny84]

Hi All,

I was wondering if this is a) possible b) someone had some example code.

I have 2 workbooks (Workbook A and Workbook B)

Workbook A - This is the main workbook which holds all required data.
Workbook B - This is a workbook which is downloaded from Microsoft Forms and has a variable name which is made up of Work Survey and a number which is based on responses entered. e.g. Work Survey (1-8).xls

What I am trying to do is when I open Workbook A and download and open Workbook B I can run a macro in Workbook A which would do either:

1) Would locate the open workbook with Work Survey in the name and then copy the worksheet from this workbook over to Workbook A. Then have another macro which I could use to automate sorting oldest to newest, deleting duplicates keeping only the newest rows based on date\time entry.

2) Workbook B - Sort oldest to newest based on date\time in column X
- Delete duplicate rows based keeping the newest based on the date in column X.
- Input Box to allow user to enter new name for spreadsheet.
- Copy the now edited sheet to the end of Workbook A

Thanks in advance,
t0ny84

 

[t0ny84]

That's good news! Does that mean it's all working, now?

Nearly (thank goodness)!
Background - To ensure we have a backup of the imported data I am having a copy of this imported workbook moved to a U:\ Drive we share access to. Currently having the workbooks save there has worked with no issue what so over. The issue is I thought instead of just having multiple files sitting around I would have them go into either a Month or Yearly Folder.

The process I am trying to do is:

- Check if folder with this year (2020) is on U:\ - This year check to go up based on Year(Now()) or similar.
- If there is a folder then the macro would just copy the backup of the imported workbook.
- If the folder doesn't exist then the macro would create the folder based on this current year\month (haven't decided yet) and then move the imported workbook backup into this folder.
- Files will be saved with a timestamp at the end of them.

Dim dt1 As String
Dim FolderYear As String 
dt1 = Format(Now(), "dd.mm.yy hh.mm.ss") 'Australian Date Formatting
FolderYear = Year(Now()) 'also tried Format(Year(Now()))

If Dir("U:\" & FolderYear, vbDirectory) = "" Then 'Have also tried using False instead of "" neither work
MkDir Path:="U:\" & FolderYear
FileCopy Fname, "U:\" & FolderYear & "\" & NewSheetName & " - " & dt1 & ".xlsx"  'example
Else
FileCopy Fname, "U:\" & FolderYear & "\" & NewSheetName & " - " & dt1 & ".xlsx"  'example
End If

The above code is giving me a Run-Time Error 1004 - Application-defined or object-defined error.
Once this is done this macro is going to bed!

Actually another question for you sykes - I currently have all of my code in one Sub I was wondering what you believe to be the best practice? All code in one Sub or multiple modules called as required?

Thanks again so much!

 

[t0ny84]

That's good news! Does that mean it's all working, now?

Hey sykes - Everything except the one last piece of the puzzle!! and it is doing my head in. The file that is opened at the start of the macro and stored in the Fname variable I want this to be copied to a folder in the background. If that folder doesn't exist then the macro is to create one. Each code I have tried either gets access issue error \ code error and I can't put my finger on why!

NewSheetName is the name given to Fname at the beginning of the macro it changes the file name to Preferences - xx.xx - xx.xx

My latest code idea is as follows:

Enter_CopyAndRename:

Dim sFolderPath As String 'This is the full folder path which is made up of the hard drive letter and Year Folder
Dim sFolderName As String ' This is for my folder name - ideally name it the current year.
Dim fs As Object
Dim newPath As String 
Dim FileName As String
Dim dt1 as String ' As I am adding a date stamp to the end of the file I am using this to change it from US date to AU date.
Dim NewSheetToText As String 'The combined new file name and date stamp

dt1 = Format(Now(), "dd.mm.yy hh.mm.ss") 'Australian Date Formatting
NewSheetToText = NewSheetName & " - " & dt1 & ".xlsx"  'Used to add details into Preferences ' Spreadsheet.
sFolderName = Year(Now()) 'To get the folder named based on current YEAR
sFolderPath = "U:\" & sFolderName 'where file should be copied to
Set fs = CreateObject("Scripting.FileSystemObject")
    
    If Right(sFolderPath, 1) <> "\" Then
        sFolderPath = sFolderPath & "\"
    End If
' Folder exists
    If Dir(sFolderPath, vbDirectory) <> vbNullString Then
Name Fname As sFolderPath & "\" & NewSheetToText

'fs.CopyFile Fname, sFolderPath & "\"
    Else

' Folder doesn't exist
MkDir sFolderPath
Name Fname As sFolderPath & "\" & NewSheetToText
'fs.CopyFile Fname, sFolderPath & "\"
Set fs = Nothing

 End If

 

[t0ny84]

Finished (until I decide to tinker with it!) ?
Below is the code I used to create the backup of the imported data.

In my searching of how to get my file copied and rename I came across this website - Working with FILES

I do not know who owns it nor do I have any affiliation to it, I just found the information was easily laid out and easy to navigate.

Another little fun thing I found - How to create progress bar in Excel with VBA
Fname in the below code is the name of the file being imported.

Enter_Back_Up_Name:
Set fso = CreateObject("Scripting.FileSystemObject")
FolderName = Year(Now())
FullFolderPath = "N:\Folder\" & FolderName & "\"
dt1 = Format(Now(), "dd.mm.yy hh.mm.ss") 'Australian Date Formatting
destFile = NewSheetName & " - " & dt1 & ".xlsx"
NewSheetToText = NewSheetName & " - " & dt1 & ".xlsx"  'Used to add details into Preferences ' Spreadsheet.

If fso.FolderExists(FullFolderPath) Then
fso.CopyFile Fname, FullFolderPath & destFile 'Copies Fname to destination Folder
' Name FullFolderPath & Fname As FullFolderPath & NewSheetToText

Else
fso.CreateFolder (FullFolderPath) 'Creates Folder
fso.CopyFile Fname, FullFolderPath & destFile 'Copies Fname to destination Folder
' Name FullFolderPath & Fname As FullFolderPath & NewSheetToText
End If

 

[sykes]

Ah ha - I was just settling down with my cup of coffee, to try and finish this off!
As I think you're on the opposite side of the world, you're probably enjoying your 3rd beer by now!!

Thanks for letting me know you've got sorted; I'd only just started, so you've saved me doing any nugatory work.

Glad we're all sorted now.