copie colle avec condition et sans cellules vides

[remid]

Bonjour à tous !!
je suis en train de ré actualiser un fichier qui est rempli de formule ds tt les sens et avec des grandes base de données. trés satisfaisant mais trés lourd ...
afin de faciliter l'accés à ce fichier ainsi que son utilisation , j'essaie de tt passer en vba.
étant novice ds ce domaine j'ai réussi a créer différent code, mais ne sont pas efficient ...

le premier copie les données de la feuille "bdd" colonne A si et seulement le chiffre en colonne "f " est positif et colle les données en feuille " calcul " en colonne " f " mais avec des cellules vides ...voici le code
comment peut on faire pour avoir ce résultat sans cellules vides entre elles ?
j'ai utilisé une boucle mais avec un nombre de ligne défini. peut on le faire de façon indéfini ?

Sub indemnité()

Dim i As Integer
For i = 1 To 600
Sheets("bdd").Activate
If Sheets("bdd").Range("f" & i).Value > 0 Then ' condition si jour de retard sup a 0'
Range("A" & i).Select 'copie colle cde '
Selection.Copy
Sheets("calcul").Select
Range("F" & i + 1).Select
ActiveSheet.Paste
Sheets("bdd").Activate 'copie colle fournisseur'
Range("b" & i).Select
Selection.Copy
Sheets("calcul").Select
Range("g" & i + 1).Select
ActiveSheet.Paste
End If
Next i
Sheets("calcul").Activate
Range("f8:f600").Select
Selection.CurrentRegion.Select
For Each Range In Selection
If Range.Value = "" Then
Range.EntireRow.Delete
End If

End Sub

le second pb c'est que j'ai un bouton pour effacer mais il marche tellement bien qu'il efface ...tous.. même les intitulé de colonnes
peut on avoir un code pour effacer juste les données a partir de telle ligne?


Sub éffacer()
Sheets("calcul").Select
Sheets("calcul").Cells.Clear


je vous remercie par avance ,
@++

 

[Grand Chaman Excel]

Re : copie colle avec condition et sans cellules vides

Bonjour remid et bienvenue sur le forum,

Il y a plusieurs façons d'arriver au résultat souhaité, voici un exemple que tu pourras adapter...:

Sub Indemnite()
    Dim i As Long
    Dim DerniereLigne As Long
    Dim DerniereLigne2 As Long
    
    DerniereLigne = Sheets("bdd").Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To DerniereLigne
        If Sheets("bdd").Cells(i, 6) > 0 Then
            DerniereLigne2 = Sheets("calcul").Range("F" & Rows.Count).End(xlUp).Row + 1
            Sheets("bdd").Cells(i, 1).Copy Sheets("calcul").Cells(DerniereLigne2, 6)
        End If
    Next i
End Sub

Sub Effacer()
    'efface à partir de la ligne 2, jusqu'à la ligne 1000
    'on peut trouver la dernière ligne comme dans la macro Indemnite
    Sheets("calcul").Range("A2:Z1000").Clear
End Sub

En passant, éviter les .Select dans tes macros. Ça ralentit et allourdi ton code inutilement.

A+

 

[remid]

Re : copie colle avec condition et sans cellules vides

bjr grand chaman excel ,
je te remercie , je vais essayer de suite et te tiens au courant... enfin si j'y arrive je ne suis que novice..
merci @+