Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Copier/coller d'une feuille excel vers une autre feuille avec des critères

anthonyhk

XLDnaute Junior
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
 

Pièces jointes

  • Agenda des traitements.xls
    14.5 KB · Affichages: 22
  • Etat des contrôles des RL.xlsm
    126.3 KB · Affichages: 21
  • Agenda des traitements.xls
    14.5 KB · Affichages: 26
  • Agenda des traitements.xls
    14.5 KB · Affichages: 25

Paritec

XLDnaute Barbatruc
Re : Copier/coller d'une feuille excel vers une autre feuille avec des critères

re Anthonyk le forum
Bon alors on considère que le sujet est réglé, tu peux rajouter résolu dans le premier post dans le titre du post
a+
Papou
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…