Bonjour,
Tous les jours, je sors une extraction sous format Excel que j’enregistre sous mon bureau (« Agenda des traitements.xls »).
J’ai un second fichier Excel (« État des contrôles des RL XXXXXXXX.xls »).
En lançant la macro via outils/macro effectuera :
1/ copier coller du ficher « Agenda des traitements » dans le fichier État des contrôles des RL XXXX dans l’onglet Agenda des traitements
2/ copier coller des lignes en dates du jour du onglet agenda des traitements du fichier Etat des contrôles dans l’onglet État de contrôle
Dans l’étape 2, j’aimerais que le copier coller ne se fasse que pour des critères bien définies (Date, nom, Prénom, Date de naissance, Adresse, Code postale, Ville, Code client)
Or, actuellement le copier coller intègre la ligne entière.
Pouvez vous m’aider svp ?
Merci
Ci-dessous la ligne de code :
Sub MACROTEST()
Dim MonExcel As Excel.Application
Dim MonFichier As Object
Dim AdresseFichier As String
Dim Reponse As Integer
Dim x As Integer
Dim y As Integer
Dim dte As Date
Dim DernLigne As Long
Application.DisplayAlerts = False
AdresseFichier = "C:\Documents and Settings\" & Left(Right(Application.UserName, 8), 7) & "\Bureau\Agenda des traitements.xls"
CheminEnregistrement = Application.ActiveWorkbook.Path
DateduJour = Format(Date, "ddmmyyyy")
Application.Worksheets("Agenda des traitements").Select
Cells.Select
Selection.Delete
Set MonExcel = CreateObject("Excel.Application")
MonExcel.Visible = True
MonExcel.DisplayAlerts = False
Set MonFichier = MonExcel.Workbooks.Open(AdresseFichier)
MonExcel.ActiveSheet.Cells.Select
MonExcel.CutCopyMode = False
MonExcel.Selection.Copy
Application.Worksheets("Agenda des traitements").Range("A1").Select
Application.ActiveSheet.Paste
Cells.Select
With Selection
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
MonFichier.Close savechanges = False
Set MonFichier = Nothing
MonExcel.Quit
Set MonExcel = Nothing
Sheets("Agenda des traitements").Range("A1").Select
Sheets("Etat de contrôle").Select
Range("B4").Select
Selection = Format(Date, "dd/mm/yyyy")
'End If
'Application.ActiveWorkbook.SaveAs _
'(CheminEnregistrement & "\Etat des contrôles des RL " & DateduJour)
dte = Date
For x = 0 To 50
If Worksheets("Agenda des traitements").Cells(10 + x, 2).Value < dte + 1 Then
Worksheets("Agenda des traitements").Activate
'Worksheets("Agenda des traitements").Cells(10 + x, 2).Select
'Worksheets("Agenda des traitements").Cells(10 + x, 5).Select
Worksheets("Agenda des traitements").Range("B" & x + 10 & ":C" & x + 10 & " " & x + 10 & ":F" & x + 10 & ":G" & x + 10 & ":H" & x + 10 & ":I" & x + 10 & ":M" & x + 10).Select
'Worksheets("Agenda des traitements").Range("B" & x + 11 & ":C" & x + 11 & " " & x + 11 & ":E" & x + 11).Select
Selection.Copy
Worksheets("Etat de contrôle").Activate
'Worksheets("Etat de contrôle").Rows.End(xlUp).Select
'Worksheets("Etat de contrôle").Cells(8 + y, 1).Select
DernLigne = Range("A65536").End(xlUp).Row + 1
Range("A" & DernLigne).PasteSpecial Paste:=xlPasteValues
Range("A" & DernLigne).PasteSpecial Paste:=xlPasteFormats
' DernLigne.Select
'ActiveSheet.Paste
'y = y + 1
End If
Next x
Application.DisplayAlerts = True
End Sub
Tous les jours, je sors une extraction sous format Excel que j’enregistre sous mon bureau (« Agenda des traitements.xls »).
J’ai un second fichier Excel (« État des contrôles des RL XXXXXXXX.xls »).
En lançant la macro via outils/macro effectuera :
1/ copier coller du ficher « Agenda des traitements » dans le fichier État des contrôles des RL XXXX dans l’onglet Agenda des traitements
2/ copier coller des lignes en dates du jour du onglet agenda des traitements du fichier Etat des contrôles dans l’onglet État de contrôle
Dans l’étape 2, j’aimerais que le copier coller ne se fasse que pour des critères bien définies (Date, nom, Prénom, Date de naissance, Adresse, Code postale, Ville, Code client)
Or, actuellement le copier coller intègre la ligne entière.
Pouvez vous m’aider svp ?
Merci
Ci-dessous la ligne de code :
Sub MACROTEST()
Dim MonExcel As Excel.Application
Dim MonFichier As Object
Dim AdresseFichier As String
Dim Reponse As Integer
Dim x As Integer
Dim y As Integer
Dim dte As Date
Dim DernLigne As Long
Application.DisplayAlerts = False
AdresseFichier = "C:\Documents and Settings\" & Left(Right(Application.UserName, 8), 7) & "\Bureau\Agenda des traitements.xls"
CheminEnregistrement = Application.ActiveWorkbook.Path
DateduJour = Format(Date, "ddmmyyyy")
Application.Worksheets("Agenda des traitements").Select
Cells.Select
Selection.Delete
Set MonExcel = CreateObject("Excel.Application")
MonExcel.Visible = True
MonExcel.DisplayAlerts = False
Set MonFichier = MonExcel.Workbooks.Open(AdresseFichier)
MonExcel.ActiveSheet.Cells.Select
MonExcel.CutCopyMode = False
MonExcel.Selection.Copy
Application.Worksheets("Agenda des traitements").Range("A1").Select
Application.ActiveSheet.Paste
Cells.Select
With Selection
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
MonFichier.Close savechanges = False
Set MonFichier = Nothing
MonExcel.Quit
Set MonExcel = Nothing
Sheets("Agenda des traitements").Range("A1").Select
Sheets("Etat de contrôle").Select
Range("B4").Select
Selection = Format(Date, "dd/mm/yyyy")
'End If
'Application.ActiveWorkbook.SaveAs _
'(CheminEnregistrement & "\Etat des contrôles des RL " & DateduJour)
dte = Date
For x = 0 To 50
If Worksheets("Agenda des traitements").Cells(10 + x, 2).Value < dte + 1 Then
Worksheets("Agenda des traitements").Activate
'Worksheets("Agenda des traitements").Cells(10 + x, 2).Select
'Worksheets("Agenda des traitements").Cells(10 + x, 5).Select
Worksheets("Agenda des traitements").Range("B" & x + 10 & ":C" & x + 10 & "
'Worksheets("Agenda des traitements").Range("B" & x + 11 & ":C" & x + 11 & "
Selection.Copy
Worksheets("Etat de contrôle").Activate
'Worksheets("Etat de contrôle").Rows.End(xlUp).Select
'Worksheets("Etat de contrôle").Cells(8 + y, 1).Select
DernLigne = Range("A65536").End(xlUp).Row + 1
Range("A" & DernLigne).PasteSpecial Paste:=xlPasteValues
Range("A" & DernLigne).PasteSpecial Paste:=xlPasteFormats
' DernLigne.Select
'ActiveSheet.Paste
'y = y + 1
End If
Next x
Application.DisplayAlerts = True
End Sub