Copy folder and rename based on cell value VBA? | MrExcel Message Board

PHOTO EMBED

Thu Sep 08 2022 07:36:14 GMT+0000 (Coordinated Universal Time)

Saved by @mathukiya

'Insert form details code


Private Sub Submitbutton_Click()




Dim emptyRow As Long



Worksheets("Data").Activate

emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

'Transfer information
Cells(emptyRow, 1).Value = Range("A4").FormulaR1C1
Cells(emptyRow, 2).Value = FirstNameBox.Value
Cells(emptyRow, 3).Value = LastNameBox.Value
Cells(emptyRow, 4).Value = Classificationbox.Value
Cells(emptyRow, 5).Value = Sitename.Value
Cells(emptyRow, 6).Value = DateofInjuryBox.Text
Cells(emptyRow, 7).Value = ReturnDateBox.Text
Cells(emptyRow, 8).Value = Range("H1").FormulaR1C1
Cells(emptyRow, 9).Value = DivisionCombo.Value
Cells(emptyRow, 10).Value = Accidentbookref.Value
Cells(emptyRow, 11).Value = InjuryCatCombo.Value
Cells(emptyRow, 12).Value = BodyAreaInjuryCombo.Value
Cells(emptyRow, 13).Value = LocationInjuryCombo.Value
Cells(emptyRow, 14).Value = ReportableYN.Value
Cells(emptyRow, 15).Value = Status.Value
Cells(emptyRow, 16).Value = Completedby.Value



'Make new Dir based on last entry value in WS location

MkDir ThisWorkbook.Path & "" & Range("R2").Value & " " & "Incident Folder"



'Sub Copy_Folder()
'This example copy all files and subfolders from FromPath to ToPath.
'Note: If ToPath already exist it will overwrite existing files in this folder
'if ToPath not exist it will be made for you.

Dim FSO As Object
Dim FromPath As String
Dim ToPath As String


FromPath = ThisWorkbook.Path & "\Template"
ToPath = ThisWorkbook.Path & "" & Range("R2").Value & " " & "Incident Folder"



ThisWorkbook.Save

End Sub
content_copyCOPY

https://www.mrexcel.com/board/threads/copy-folder-and-rename-based-on-cell-value-vba.984272/