Copy folder and rename based on cell value VBA? | MrExcel Message Board
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/
Comments