Copier coller d'un onglet dans un autre avec certains critères

anthonyhk

XLDnaute Junior
Bonjour,

J'ai deux fichiers :

Agenda des traitements
Etat des controles des RL

Ma macro copie le fichier Agenda des traitements dans l'onglet agenda des traitements du fichier Etat des controles des RL puis "devrait" copier les données selon certains critères (date, nom, prénom, date de naissance, adresse, code postal, ville et code client) avec la date du jour.

Or je n'arrive pas a inclure la 1ère ligne (ex : jean dupond) et la date du 17/04 est incluse (ex : pastore javier) mais que pour la 1ère ligne avec le 17/04.
De plus, je voudrais inclure et exclure certaine donnée :
Exclusion du lieu de naissance, frère, soeur et situation familiale.

Pouvez vous m'aider svp :)

ci joint les deux fichiers pour mieux comprendre.
 

Pièces jointes

  • Agenda des traitements.xls
    14.5 KB · Affichages: 26
  • Etat des contrôles des RL 15042014.xlsm
    127.2 KB · Affichages: 30
  • Agenda des traitements.xls
    14.5 KB · Affichages: 28
  • Agenda des traitements.xls
    14.5 KB · Affichages: 34

anthonyhk

XLDnaute Junior
Re : Copier coller d'un onglet dans un autre avec certains critères

J'avais oublié de mttre mon code que j'avais déjà fais je crois. le voici :)

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")

'Reponse = MsgBox("Le fichier Agenda des traitements est-il du jour?",
'vbYesNo + vbQuestion, "Mise à jour agenda")

'If Reponse = vbNo Then

'MsgBox prompt:="Mettre à jour le fichier Agenda des traitements", Buttons:=vbExclamation

'Exit Sub

'Else

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").Range("B" & x + 11 & ":C" & x + 11 & ":D" & x + 11 & ":F" & x + 11 & ":G" & x + 11 & ":H" & x + 11 & ":I" & x + 11 & ":M" & x + 11).Select
'Worksheets("Agenda des traitements").Range("B" & x + 11 & ":C" & x + 11 & ":D" & 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

Merci de votre aide :))
 

Discussions similaires

Statistiques des forums

Discussions
312 229
Messages
2 086 422
Membres
103 206
dernier inscrit
diambote