Copier coller
Fermé
pat
-
Modifié le 5 nov. 2017 à 13:29
yg_be Messages postés 23471 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 15 février 2025 - 5 nov. 2017 à 23:31
yg_be Messages postés 23471 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 15 février 2025 - 5 nov. 2017 à 23:31
A voir également:
- Copier coller
- Copier coller pdf - Guide
- Historique copier-coller android - Guide
- Copier-coller - Accueil - Informatique
- Arobase copier coller - Forum Clavier
- Symbole clavier copier coller - Guide
2 réponses
yg_be
Messages postés
23471
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 février 2025
Ambassadeur
1 568
Modifié le 5 nov. 2017 à 15:54
Modifié le 5 nov. 2017 à 15:54
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!!!!!
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!!!!!
yg_be
Messages postés
23471
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
15 février 2025
1 568
5 nov. 2017 à 23:31
5 nov. 2017 à 23:31
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