Hello Folks
I have a code that pulls data but I want to make it so I can save the file as the "20200305 - Employee Name",
Please see code below and any suggestions will be taken on board with the coding!
Also, if possible a string to save the file path to e.g "J:\SaveFileHere" which is editable?
Thanks in advance
I have a code that pulls data but I want to make it so I can save the file as the "20200305 - Employee Name",
Please see code below and any suggestions will be taken on board with the coding!
Also, if possible a string to save the file path to e.g "J:\SaveFileHere" which is editable?
VBA Code:
Option Explicit
Const FOLDER_PATH = "File_Path_Here" 'REMEMBER END BACKSLASH
Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim FileName As String
Dim rowTarget As Long 'output row
Dim MyDate
Dim Month
rowTarget = 2
'check the folder exists
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If
'reset application settings in event of error
On Error GoTo errHandler
Application.ScreenUpdating = False
'set up the target worksheet
Set wsTarget = Sheets("Sheet1")
'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets(1)
'import the data
With wsTarget
.Range("A" & rowTarget).Value = wsSource.Range("B4:C4").Value
.Range("B" & rowTarget).Value = wsSource.Range("B5:C5").Value
.Range("C" & rowTarget).Value = wsSource.Range("C9:D9").Value
.Range("D" & rowTarget).Value = wsSource.Range("E4").Value
.Range("E" & rowTarget).Value = wsSource.Range("B33:C33").Value
.Range("F" & rowTarget).Value = wsSource.Range("B34:C34").Value
.Range("G" & rowTarget).Value = wsSource.Range("A26:E30").Value
.Range("I" & rowTarget).Value = sFile 'Source File
FileName = Range("A" & rowTarget).Value = wsSource.Range("B4:C4").Value 'Payroll No
End With
MyDate = Format(Date, "yyyymmdd")
Month = Format(Date, "mmmm")
ActiveWorkbook.SaveAs ("File_path_Here" & Format(Now(), "yyyymmdd - ") & FileName & ".xlsx")
Application.DisplayAlerts = False
wbSource.Close
rowTarget = rowTarget + 1
sFile = Dir()
Loop
errHandler:
On Error Resume Next
Application.ScreenUpdating = True
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing
End Sub
Private Function FileFolderExists(strPath As String) As Boolean
If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function
Thanks in advance