Option Explicit
Sub SaveAndLogForm()
Dim fPATH As String, NR As Long
fPATH = "C:\Path\To\Save\" 'remember the final \ in this string
Application.ScreenUpdating = False 'turn off screen flicker, speed up macro
ActiveSheet.Copy 'copies the form to a new workbook
ActiveWorkbook.SaveAs fPATH & Range("A1").Value & ".xlsx", 51 'save the workbook
ActiveWorkbook.Close False 'close the new workbook
With Sheets("Estimate Log")
NR = .Range("B" & .Rows.Count).End(xlUp).Row + 1 'next empty row
.Range("B" & NR).Value = Range("I2").Value 'map to transfer values
.Range("C" & NR).Value = Range("B8").Value
.Range("D" & NR).Value = Range("B9").Value
.Range("E" & NR).Value = Range("B10").Value
.Range("F" & NR).Value = Range("B11").Value
.Range("G" & NR).Value = Range("E7").Value
.Range("H" & NR).Value = Range("J40").Value
.Range("I" & NR).Value = Range("A15").Value
.Range("J" & NR).Value = Range("B15").Value
.Range("K" & NR).Value = Range("A16").Value
.Range("L" & NR).Value = Range("B16").Value
.Range("M" & NR).Value = Range("B17").Value
.Range("N" & NR).Value = Range("A18").Value
.Range("O" & NR).Value = Range("B18").Value
.Range("P" & NR).Value = Range("A19").Value
.Range("Q" & NR).Value = Range("B19").Value
.Range("R" & NR).Value = Range("A20").Value
.Range("S" & NR).Value = Range("B20").Value
.Range("T" & NR).Value = Range("A21").Value
.Range("U" & NR).Value = Range("B21").Value
.Range("V" & NR).Value = Range("A22").Value
.Range("W" & NR).Value = Range("B22").Value
.Range("X" & NR).Value = Range("A23").Value
.Range("Y" & NR).Value = Range("B23").Value
.Range("Z" & NR).Value = Range("A24").Value
.Range("AA" & NR).Value = Range("B24").Value
.Range("AB" & NR).Value = Range("A25").Value
.Range("AC" & NR).Value = Range("B25").Value
.Range("AD" & NR).Value = Range("A26").Value
.Range("AE" & NR).Value = Range("B26").Value
.Range("AF" & NR).Value = Range("A27").Value
.Range("AG" & NR).Value = Range("B27").Value
.Range("AH" & NR).Value = Range("A28").Value
.Range("AI" & NR).Value = Range("B28").Value
.Range("AJ" & NR).Value = Range("A29").Value
.Range("AK" & NR).Value = Range("B29").Value
.Range("AL" & NR).Value = Range("A30").Value
.Range("AM" & NR).Value = Range("B30").Value
.Range("AN" & NR).Value = Range("A31").Value
.Range("AO" & NR).Value = Range("B31").Value
.Range("AP" & NR).Value = Range("A32").Value
.Range("AQ" & NR).Value = Range("B32").Value
.Range("AR" & NR).Value = Range("A33").Value
.Range("AS" & NR).Value = Range("B33").Value
.Range("AT" & NR).Value = Range("A34").Value
.Range("AU" & NR).Value = Range("B34").Value
.Range("AV" & NR).Value = Range("A35").Value
.Range("AW" & NR).Value = Range("B35").Value
.Range("AX" & NR).Value = Range("A36").Value
.Range("AY" & NR).Value = Range("B36").Value
.Range("AZ" & NR).Value = Range("A37").Value
.Range("BA" & NR).Value = Range("B37").Value
.Range("BB" & NR).Value = Range("A38").Value
.Range("BC" & NR).Value = Range("B38").Value
.Range("BD" & NR).Value = Range("A39").Value
.Range("BE" & NR).Value = Range("B39").Value
End With
'clear cells
Range("I2,B8,B9,B10,B11,E7,J40,A15,B15,A16,B16,A17,B17,A18,B18,A19,B19,A20,B20,A21,B21,A22,B22,A23,B23,A24,B24,A25,B25,A26,B26,A27,B27,A28,B28,A29,B29,A30,B30,A31,B31,A32,B32,A33,B33,A34,B34,A35,B35,A36,B36,A37,B37,A38,B38,A39,B39").ClearContents
Application.ScreenUpdating = True 'screen back to normal
End Sub
Bookmarks