Goedemorgen all,
Ik ben opzoek naar een stukje VBA code om op te nemen in mijn macro waarmee ik een excel bestand kan wegschrijven met een week nummer er aan toegevoegd.
bijvoorbeeld
C:\Temp\LRT_Last_Week\DataEntryPuDRoutes - Wk31.xlsm
C:\Temp\LRT_Last_Week\DataEntryPuDRoutes - Wk32.xslm
C:\Temp\LRT_Last_Week\DataEntryPuDRoutes - Wk33.xlsm
mijn huidige vba code is als volgt
Sub LW_Xlsx_PuD_Routes()
'
' DataEntryPuDRoutes Macro
'
' by hvermeer
'
'
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 2), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
46, 1), Array(47, 1), Array(48, 1), Array(49, 1)), TrailingMinusNumbers:=True
Range("A1").Select
Cells.Replace What:="é", Replacement:="é", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveSheet.Name = "PUD_Routes"
ChDir "C:\Temp\LRT_Last_Week"
ActiveWorkbook.SaveAs Filename:= _
"C:\Temp\LRT_Last_Week\DataEntryPuDRoutes.xlsx", _
FileFormat:=51, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.Quit
End Sub
alvast hartelijk dank
Harold
Ik ben opzoek naar een stukje VBA code om op te nemen in mijn macro waarmee ik een excel bestand kan wegschrijven met een week nummer er aan toegevoegd.
bijvoorbeeld
C:\Temp\LRT_Last_Week\DataEntryPuDRoutes - Wk31.xlsm
C:\Temp\LRT_Last_Week\DataEntryPuDRoutes - Wk32.xslm
C:\Temp\LRT_Last_Week\DataEntryPuDRoutes - Wk33.xlsm
mijn huidige vba code is als volgt
Sub LW_Xlsx_PuD_Routes()
'
' DataEntryPuDRoutes Macro
'
' by hvermeer
'
'
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 2), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
46, 1), Array(47, 1), Array(48, 1), Array(49, 1)), TrailingMinusNumbers:=True
Range("A1").Select
Cells.Replace What:="é", Replacement:="é", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveSheet.Name = "PUD_Routes"
ChDir "C:\Temp\LRT_Last_Week"
ActiveWorkbook.SaveAs Filename:= _
"C:\Temp\LRT_Last_Week\DataEntryPuDRoutes.xlsx", _
FileFormat:=51, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.Quit
End Sub
alvast hartelijk dank
Harold