Copier coller
pat
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention -
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Alors voila je cherche a faire un petit Code VBa qui me permettrais de faire un copier coller.
j'ai récupérer un code bien complet et j'ai essayer de l'adapter au mieux a ma situation
Globalement ca se passe plutôt bien excepté le fait qu'il me copie les lignes vide.
Je voudrais donc ajouter une condition copier uniquement les ligne qui contienne au moins 1 valeur "texte ou numérique" (attention le tableau est remplis de formule)
Merci d'avance a ceux qui essayerons de m'aider!
Alors voila je cherche a faire un petit Code VBa qui me permettrais de faire un copier coller.
j'ai récupérer un code bien complet et j'ai essayer de l'adapter au mieux a ma situation
Globalement ca se passe plutôt bien excepté le fait qu'il me copie les lignes vide.
Je voudrais donc ajouter une condition copier uniquement les ligne qui contienne au moins 1 valeur "texte ou numérique" (attention le tableau est remplis de formule)
Sub completer_Base_de_donnée_1()
'----compléter Database 1
Range("CT12:DN45").Select
Selection.Copy
Sheets("Base_de_donnée_1").Select
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
ActiveSheet.Range("A2").Select
Dim MyTable1 As ListObject
Set MyTable1 = Application.Worksheets("Base_de_donnée_1").ListObjects("Database1")
Dim LastRow As Long
LastRow = MyTable1.ListRows.Count + 2
ActiveSheet.Range("A" & LastRow).Select
If ActiveCell.Value <> "" Then
On Error Resume Next
ActiveCell.Offset(1, 0).Select
Err.Clear
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'----compléter Database 2
End Sub
Merci d'avance a ceux qui essayerons de m'aider!
2 réponses
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 588
bonjour, je suggère ceci:Sub completer_Base_de_donnée_1() Dim dest As Range Dim pave As Range, cell As Range Dim vide As Boolean Dim lig As Range, clig As Range Dim lpave As Long '----compléter Database 1 Set pave = Range("CT12:DN45") lpave = pave.Columns.Count Sheets("Base_de_donnée_1").Select If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False ActiveSheet.Range("A2").Select Dim MyTable1 As ListObject Set MyTable1 = Application.Worksheets("Base_de_donnée_1").ListObjects("Database1") Dim LastRow As Long LastRow = MyTable1.ListRows.Count + 2 ActiveSheet.Range("A" & LastRow).Select If ActiveCell.Value <> "" Then On Error Resume Next ActiveCell.Offset(1, 0).Select Err.Clear End If Set dest = Selection For Each lig In pave.Rows Set clig = Intersect(pave, lig) vide = True For Each cell In clig If cell <> "" Then vide = False Exit For End If Next cell If Not vide Then dest.Resize(1, lpave).Cells.Value = clig.Cells.Value Set dest = dest.Offset(1, 0) End If Next lig '----compléter Database 2 End Sub -
Merci Yg-be
a première vue ton code fonctionne parfaitement, je vais encore faire des test pendant quelques jour et j'espere que je ne verrais pas de bug apparaître!!
Donc tout ce que j'ai a dire en ce moment c'est MERCI!!!!!-
petit changement:
Sub completer_Base_de_donnée_1() Dim dest As Range Dim pave As Range, cell As Range Dim vide As Boolean Dim lig As Range, clig As Range '----compléter Database 1 Set pave = Range("CT12:DN45") Sheets("Base_de_donnée_1").Select If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False ActiveSheet.Range("A2").Select Dim MyTable1 As ListObject Set MyTable1 = Application.Worksheets("Base_de_donnée_1").ListObjects("Database1") Dim LastRow As Long LastRow = MyTable1.ListRows.Count + 2 ActiveSheet.Range("A" & LastRow).Select If ActiveCell.Value <> "" Then On Error Resume Next ActiveCell.Offset(1, 0).Select Err.Clear End If Set dest = Selection.Resize(1, pave.Columns.Count) For Each lig In pave.Rows Set clig = Intersect(pave, lig) vide = True For Each cell In clig If cell <> "" Then vide = False Exit For End If Next cell If Not vide Then dest.Cells.Value = clig.Cells.Value Set dest = dest.Offset(1, 0) End If Next lig '----compléter Database 2 End Sub
-
