1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
| Option Explicit
Public WbSource As Workbook
Public ShCible As Worksheet
Public ShSource As Worksheet
Public ShTitreModele As Worksheet
Public AireCsv As Range
Public DerniereLigne As Long
Sub ChangerLExtensionDunFichierCsvEnTxt(Chemin As String, Fichier As String)
Chemin = "C:\Documents and Settings\admv6\Bureau\TMS"
Fichier = "planning.csv"
Name Chemin & Fichier As Replace(Chemin & Fichier, ".csv", ".txt")
End Sub
Sub CopieBD()
'
' CopieBD Macro
'
Set ShCible = Sheets("BD")
Set ShTitreModele = Sheets("Titre modèle")
ChangerLExtensionDunFichierCsvEnTxt "C:\Documents and Settings\admv6\Bureau\TMS", "planning.csv"
'ThisWorkbook.Sheets("BD")
Sheets("BD").Select
Range("A2:AY1000").Select
Range("AY2").Activate
Selection.Cut
Application.CutCopyMode = False
Application.DisplayAlerts = False
Selection.ClearContents
ChDir "C:\Documents and Settings\admv6\Bureau\TMS"
Workbooks.Open Filename:= _
"C:\Documents and Settings\admv6\Bureau\TMS\planning.csv"
Windows("planning.csv").Activate
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 2), Array(6, 2), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), 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, 2), Array(43, 1), Array(44, 1), Array(45, 2), Array( _
46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1)) _
, TrailingMinusNumbers:=True
Application.DisplayAlerts = True
Set WbSource = ActiveWorkbook
Set AireCsv = Range(ActiveSheet.Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))
' Copie du fichier Csv
AireCsv.Copy
ShCible.Activate
ShCible.Cells(1, 1).Select
ShCible.Paste
Set AireCsv = Nothing
' Copie de la ligne de titre
ShTitreModele.Range(ShTitreModele.Cells(1, 1), ShTitreModele.Cells(1, ShTitreModele.UsedRange.Columns.Count)).Copy
ShCible.Activate
ShCible.Cells(1, 1).Select
ShCible.Paste
Application.Workbooks("planning.csv").Close SaveChanges:=True
Set WbSource = Nothing
Set ShTitreModele = Nothing
Set ShCible = Nothing
Application.CutCopyMode = False
End Sub |