VBA transfert feuiile1 Feuille2

[JJ]

Bonjour,
pouvez vous m'aider à écrire un code simple vba pour transferer certaines lignes de la feuille 1 à la feuille , si possible par exclusion (si different alors je transfère, plutôt que si c'est cela alors je transfère)
je joins un ex
Bonne AM
et merci
JJ [file name=transfert_20060517124029.zip size=3013]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/transfert_20060517124029.zip[/file]

 

[Gorfael]

salut
Un méthode possible.

Sub Macro1()
Dim Lg_Active_1 As Integer
Dim Lg_Active_2 As Integer
Dim Nb_ligne As Integer
Dim X As Integer

'Calcul du nombre de ligne à vérifier
Nb_ligne = Sheets('feuil1').Range('A1').End(xlDown).Row

'Si le nombre de lignes est incohérent, on sort
If Nb_ligne  65000 Then
    'avertissement
    MsgBox ('nb lignes = ' & Nb_ligne & Chr(13) & _
            'valeur incohérent : arrêt macro')
    Exit Sub
End If

'Calcul de la ligne active feuille 2
Lg_Active_2 = Sheets('feuil2').Range('A1').End(xlDown).Row + 1

'Boucle de transfert
For Lg_Active_1 = 1 To Nb_ligne
    If UCase(Sheets('feuil1').Cells(Lg_Active_1, 3)) ****différent de**** 'K7' And _
       UCase(Sheets('feuil1').Cells(Lg_Active_1, 3)) ****différent de**** 'G7' Then
    'pas K7 ou G7
        'on copie
        Sheets('feuil1').Activate
        ActiveSheet.Range('A' & Lg_Active_1 & ':D' & Lg_Active_1).Copy
        Sheets('Feuil2').Activate
        'on colle
        Range('A' & Lg_Active_2).Select
        ActiveSheet.Paste
        'marquage ligne à effacer
        Sheets('Feuil1').Cells(Lg_Active_1, 8) = 'X'
        'ligne suivante (vide)
        Lg_Active_2 = Lg_Active_2 + 1
    End If
Next

'Effacement des lignes marquées
Sheets('feuil1').Activate
For X = Nb_ligne To 1 Step -1
    If Cells(X, 8) = 'X' Then
        Range('A' & X & ':H' & X).Select
        Selection.Delete Shift:=xlUp
    End If
Next
End Sub

il faut juste remplacer le texte ****différent de**** par les caractères inf et sup. Quand je les mets, le serveur me fait plein de misères.
A+

Message édité par: Gorfael, à: 17/05/2006 20:44

 

[JJ]

Bonsoir et merci Gorfael,
je vais tester ta macro demain
Bonne soirée
JJ

 

[JJ]

Bonsoir,
J'ai testé la macro sur mon petit fichier, j'ai erreur 6 depassement de capacité?
(je joins le fichier avec la macro incluse)
N'existe t il pas aussi la fonction 'transferer' plutot que paste et delete , ce n'est pas plus facile a utiliser et plus court en macro?
Merci et bonne soirée
JJ [file name=transfert_20060518194628.zip size=8536]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/transfert_20060518194628.zip[/file]

 

[Gorfael]

Salut JJ
Effectivement, tu passes en dépassement de capacité. L'erreur vient de là :
'Calcul de la ligne active feuille 2
Lg_Active_2 = Sheets('feuil2').Range('A1').End(xlDown).Row + 1[/quote]Comme ta feuille est vide, A2 est vide est donc

Sheets('feuil2').Range('A1').End(xlDown).Row
pointe sur la ligne 65535 si on ajoute 1, on pointe sur la ligne 65536 qui est en dehors des capacités d'Excel.
2 solutions : soit tu utilises la ligne 1 pour mettre les titres de tes colonnes, soit tu remplace l'instruction par celles qui suit :

'Calcul de la ligne active feuille 2
If IsEmpty(A1) Then
Lg_Active_2 = 1
Else
Lg_Active_2 = Sheets('feuil2').Range('A1').End(xlDown).Row + 1
End If

A+

 

[JJ]

Re,
merci je vais corriger demain matn
Bonne soirée
JJ