copier avec 1 macro avec condition

[calou68]

bonjour à tous

je joints 2 fichiers en pièces jointes
Cijoint.fr - Service gratuit de dépôt de fichiers
Cijoint.fr - Service gratuit de dépôt de fichiers

J'ai un fichier "STOCK ING-2" ou j'insère des données dans la feuille "export ing" et elles sont triées sous la feuille "BASE"
J'ai un 2ème fichier "Suivi hypervision-22" ou je colle les valeurs des cellules de "BASE" via la macro ci dessous

sub copieING()
Range("A2:L100").Select
Selection.Copy
Windows("Suivi hypervision-22.xls").Activate
Range("A" & Range("A65535").End(xlUp).Row + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub


jusque là tout fonctionne très bien mais le soucis c'est la ligne de la macro "Range("A2:L100").Select"
cette ligne va copier de 1 à 100 puis de 101 à 201..... ce qui va me laisser plein de lignes vides.
J'aimerai, si c'est possible de copier que les lignes ou les cellules sont non vides (attention c'est bien la valeur de la cellule que je copie et non la cellule).
la macro doit copier le fichier "base" dans la première ligne vide trouvée dans "Suivi hypervision-22".

merci pour votre dévouement.
bon week end

calou

 

[JNP]

Re : copier avec 1 macro avec condition

Bonjour Calou68 ,
Tu utilises pour déterminer la première ligne vide de "Suivi hypervision-22" la méthode

Range("A" & Range("A65535").End(xlUp).Row + 1).Select

Il te suffit de l'utiliser pour restreindre la zone à copier dans "BASE"

Range("A2:L" & Range("A65535").End(xlUp).Row).Select

Bon WE

 

[calou68]

Re : copier avec 1 macro avec condition

merci pour ta réponse, mais il y a un petit soucis.

la ligne "Range("A2:L" & Range("A65535").End(xlUp).Row).Select" copie aussi les lignes ou se trouve des formules de type "=SI('Export ING'!A10="";"";'Export ING'!A10)" dont le résultat peut être rien "".
Ces formules étant incrémentées sur plus le 3500lignes, cela fait beaucoup de vide entre chaque copies.
Peut-on faire la même copie sans prendre en compte les lignes où le résultat est "".
merci pour votre aide

bon week end

 

[JNP]

Re : copier avec 1 macro avec condition

Re ,
Voici un code à remettre à ta sauce pour les classeurs différents (là, je l'ai juste mis pour 2 feuilles dans le même classeur).

Sub Test()
Dim DerLigne As Integer, MaSélection As Range, I As Integer
With Sheets("Feuil1")
    DerLigne = .Range("A65535").End(xlUp).Row
    For I = 1 To DerLigne
        If .Cells(I, 1) <> "" Then
            If MaSélection Is Nothing Then
            Set MaSélection = .Range("A" & I & ":L" & I)
            Else
            Set MaSélection = Union(MaSélection, .Range("A" & I & ":L" & I))
            End If
        End If
    Next I
    MaSélection.Copy
End With
Sheets("Feuil2").Range("A" & Range("A65535").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Bon dimanche

 

[calou68]

Re : copier avec 1 macro avec condition

bonjour,

Merci, j'ai testé ton code sur une feuille vierge ci dessous. J'ai inséré un bouton pour la macro.
Quand je clique sur le bouton, il va copier sur la feuille 2 à la ligne A27 au lieu de A1 et si je clique une deuxième fois sur le bouton, il recopie encore sur A27 au lieu de A54.....
Désolé de vous embêter mais j'ai essayé de modifier le code, la boucle IF ou le signe<>, sans succès.

bon dimanche

 

[JNP]

Re : copier avec 1 macro avec condition

Re ,
Désolé, une petite erreur dans le code

Sheets("Feuil2").Range("A" & [COLOR=red][B]Sheets("Feuil2").[/B][/COLOR]Range("A65535").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

pour déterminer la dernière ligne de la feuille 2, et non de la feuille active.
Bon dimanche

 

[calou68]

Re : copier avec 1 macro avec condition

C'est super, cela fonctionne très bien, je l'ai adapté à deux fichiers distincts et cela marche.
bravo JNP

a bientôt et bonne soirée

 

[Staple1600]

Re : copier avec 1 macro avec condition

Bonsoir calou68, JNregexP , le fil, le forum


Une autre façon (qui permet d'éviter la boucle)

Sub a()
Application.ScreenUpdating = False
With Sheets(1)
    .[A1].AutoFilter 1, "<>"
    .[_FilterDataBase].Copy Sheets(2).[A65536].End(xlUp)(2)
    .AutoFilterMode = False
End With
Application.CutCopyMode = False
End Sub

PS: test O sur la PJ du message de 11h02