COPIER/COLLER Tableau sauf ligne vide

[Naeva]

Bonjour à toutes et à tous.

J'ai un sérieux problème et après plusieurs heures de recherches et de test afin d'adapter les différentes macros trouvées ici et là je n'y arrive pas

Voici mon problème, j'ai un tableau qui compte en réalité 30 lignes (je l'ai raccourci pour l'exemple) , je souhaiterai le copier/coller via une macro sur la feuil2 ça je sais faire.
Mon problème c'est que je souhaite que la macro ne sélectionne que les lignes où la colonne D est remplie et là malgré différents tests je n'y arrive toujours pas.

Merci de votre aide
Cordialement

 

[xltools]

Re : COPIER/COLLER Tableau sauf ligne vide

Bonjour Naeva

Tu dois coder une procédure qui copiera ligne à ligne ton tableau en vérifiant pour chaque ligne x que la cellule Dx est remplie.

Sub Exemple

DIm ligne as Long

for ligne = 1 to 2 ThisWorkbook.Sheets("Feuil1").Range("A2:A" & ThisWorkbook.Sheets("Feuil1").Range("A:A").End(xlDown).Row)

if ThisWorkbook.Sheets("Feuil1").Range("D" & ligne).Value <> "" then
ThisWorkbook.Sheets("Feuil1").Range("A" & ligne).Value = ThisWorkbook.Sheets("Feuil1").Range("A" & ligne).Value
ThisWorkbook.Sheets("Feuil1").Range("B" & ligne).Value = ThisWorkbook.Sheets("Feuil1").Range("B" & ligne).Value
ThisWorkbook.Sheets("Feuil1").Range("C" & ligne).Value = ThisWorkbook.Sheets("Feuil1").Range("C" & ligne).Value
ThisWorkbook.Sheets("Feuil1").Range("D" & ligne).Value = ThisWorkbook.Sheets("Feuil1").Range("D" & ligne).Value
ThisWorkbook.Sheets("Feuil1").Range("E" & ligne).Value = ThisWorkbook.Sheets("Feuil1").Range("E" & ligne).Value
ThisWorkbook.Sheets("Feuil1").Range("F" & ligne).Value = ThisWorkbook.Sheets("Feuil1").Range("F" & ligne).Value
End if

Next
End sub

Essaie ça et tiens moi au courant !
Hanane.

 

[Naeva]

Re : COPIER/COLLER Tableau sauf ligne vide

Bonjour Hanane

Merci beaucoup de ta réponse mais je rencontre un problème sur la ligne :
for ligne = 1 to 2 ThisWorkbook.Sheets("Feuil1").Range("A2:A"
& ThisWorkbook.Sheets("Feuil1").Range("A:A").End(xlD own).Row)

Il me met erreur de compilation attendu fin d'instruction et je ne sais pas ni ce que cela signifie ni comment régler le problème
merci

 

[Legolas]

Re : COPIER/COLLER Tableau sauf ligne vide

Bonjour,

Une solution est de passer par un tableau mémoire afin de prendre toutes les données en un seul traitement et tout recopier d'un coup.

En supposant que la colonne A est toujours non vide dès qu'il y a une ligne de données :
Dans un module :

Sub traitement()
Dim tabv1(0 To 5000, 0 To 10)

'Récupération des données
Worksheets("Feuil1").Select
i = 2
k = 0

Do While Cells(i, 1) <> ""
If Cells(i, 4) <> "" Then
tabv1(k, 0) = Cells(i, 1)
tabv1(k, 1) = Cells(i, 2)
tabv1(k, 2) = Cells(i, 3)
tabv1(k, 3) = Cells(i, 4)
tabv1(k, 4) = Cells(i, 5)
tabv1(k, 5) = Cells(i, 6)

k = k + 1
End If
i = i + 1
Loop

'Recopie des données
Worksheets("Feuil2").Select
If k <> 0 Then Range(Cells(2, 1), Cells(2 + k, 6)).Resize(k, 6) = tabv1

End Sub
++

 

[chasseur44]

Re : COPIER/COLLER Tableau sauf ligne vide

essai cela

 

[Robert]

Re : COPIER/COLLER Tableau sauf ligne vide

Bonjour Naeva , Hanane, bonjour le forum,

Naeva : je pense que tu as essayé le code de Hanane sur un fichier pas encore enregistré et ça a planté sur ThisWorkBook...
Une autre proposition proche de la sienne :

Sub Macro4()
Dim pl As Range 'déclare la variable pl (PLage)
Dim dl As Byte 'déclare la variable dl (Dernière Ligne)
Dim dest As Rang ''déclare la variable dest (cellule de DESTination)

Set pl = Sheets("Feul2").Range("A1").CurrentRegion 'définit la plage pl
pl.Offset(1, 0).Resize(pl.Rows.Count - 1, pl.Columns.Count).ClearContents 'efface les anciennes données
dl = Sheets("Feuil1").Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne A de l 'onglet "Feuil1"
For Each cel In Sheets("Feuil1").Range("A2:A" & dl) 'boucle sur toutes les cellules éditée de la colonne A (en partant de la ligne 2)
    If cel.Offset(0, 3).Value <> "" Then 'condition : si la cellule associée en colonne C n'est aps vide
        Set dest = Sheets("Feuil2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'de'finit la cellule de destination
        cel.Resize(1, 6).Copy dest 'copie et colle la ligne dans dest
    End If 'fin de la condition
Next cel 'prochaien cellule de la boucle
End Sub

Hanane : Quelle entrée fracassante dans le forum ! À peine une poignée de réponses mais que du très bon niveau... Soit la bienvenue parmi nous !

[Édition]
Bonjour Legolas, Chasseur, nos posts se sont croisés...

 

[Naeva]

Re : COPIER/COLLER Tableau sauf ligne vide

Merci beaucoup à tous !!!

j'ai choisi de prendre la solution du chasseur car la plus simple à adapter à mon cas mais je rencontre un dernier problème qui m'empeche d'atteindre le but ultime.
certaine de mes colonnes sont des calculs il faut donc que je fasse un Paste Value mais avec le code du chasseur vba ne veut pas quand je transforme paste en paste value !!!

 

[xltools]

Re : COPIER/COLLER Tableau sauf ligne vide

Merci Robert, c'est un plaisir d'être parmi vous !

 

[Legolas]

Re : COPIER/COLLER Tableau sauf ligne vide

Merci beaucoup à tous !!!

j'ai choisi de prendre la solution du chasseur car la plus simple à adapter à mon cas mais je rencontre un dernier problème qui m'empeche d'atteindre le but ultime.
certaine de mes colonnes sont des calculs il faut donc que je fasse un Paste Value mais avec le code du chasseur vba ne veut pas quand je transforme paste en paste value !!!

En prenant le code que j'ai proposé il suffit de faire un ".value"

Sub traitement()
Dim tabv1(0 To 5000, 0 To 10)

'Récupération des données
Worksheets("Feuil1").Select
i = 2
k = 0

Do While Cells(i, 1) <> ""
If Cells(i, 4) <> "" Then
tabv1(k, 0) = Cells(i, 1).value
tabv1(k, 1) = Cells(i, 2).value
tabv1(k, 2) = Cells(i, 3).value
tabv1(k, 3) = Cells(i, 4).value
tabv1(k, 4) = Cells(i, 5).value
tabv1(k, 5) = Cells(i, 6).value

k = k + 1
End If
i = i + 1
Loop

'Recopie des données
Worksheets("Feuil2").Select
If k <> 0 Then Range(Cells(2, 1), Cells(2 + k, 6)).Resize(k, 6) = tabv1

End Sub


Je pense que ce n'est pas plus compliqué ^^

 

[Naeva]

Re : COPIER/COLLER Tableau sauf ligne vide

Le problème legolas c'est que dans le "vrai" cas que je ne peux pas diffuser le tableau est en XEX 1048546 et les lignes sélectionnée doivent atterrir sur la deuxième feuille à partir de A25

étant novice en vba , le code du chasseur me paraissait plus clair et donc plus facilement adaptable

 

[Legolas]

Re : COPIER/COLLER Tableau sauf ligne vide

ok, pour simplifier je suis passé par des paramètres (cela devrait t'aider à comprendre la démarche)
donc si tu le souhaites, il te suffit juste de changer les valeurs des paramètres
cette macro marche pour 5000 lignes et 10 colonnes (sinon, il faut augmenter la taille de tabv1)

Sub traitement()
Dim tabv1(0 To 5000, 0 To 10)

'Paramètres
ligne_debut_donnees = 2 'sans la ligne des titres
ligne_debut_recopie = 2
colonne_debut_recopie = 1
nb_colonne_a_copier = 6

'Récupération des données
Worksheets("Feuil1").Select
i = ligne_debut_donnees
k = 0

Do While Cells(i, 1) <> ""
If Cells(i, 4) <> "" Then
tabv1(k, 0) = Cells(i, 1).value
tabv1(k, 1) = Cells(i, 2).value
tabv1(k, 2) = Cells(i, 3).value
tabv1(k, 3) = Cells(i, 4).value
tabv1(k, 4) = Cells(i, 5).value
tabv1(k, 5) = Cells(i, 6).value

k = k + 1
End If
i = i + 1
Loop

'Recopie des données
Worksheets("Feuil2").Select
If k <> 0 Then Range(Cells(ligne_debut_recopie, colonne_debut_recopie), Cells(ligne_debut_recopie + k, colonne_debut_recopie+nb_colonne_a_copier-1)).Resize(k, nb_colonne_a_copier) = tabv1

End Sub

 

[Naeva]

Re : COPIER/COLLER Tableau sauf ligne vide

Bonjour Bonjour !!!

MERCIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIi

Ton code marche super legolas merci pour ces explications.

et merci à tous d'avoir pris un peu de votre temps pour me répondre

 

[Naeva]

Re : COPIER/COLLER Tableau sauf ligne vide

Re bonjour j'ai une autre question :

voilà mon tableau peut avoir de 1 à 30 lignes mais dessous il me faut un texte de conclusion je voulais donc créer une macro qui le copie/colle sous la dernière ligne remplie j'ai fait ceci :

Sub misenepage()
'
' misenepage Macro
'

Sheets("param").Select
Range("A34:G47").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("facture").Select
Range("A65536").End(xlUp).Select
ActiveSheet.Paste

End Sub


Le problème c'est que si la dernière ligne remplie est la 30, il commence à copier à la ligne 30 effaçant alors ce qui il y avait sur cette dernière.

merci

 

[Legolas]

Re : COPIER/COLLER Tableau sauf ligne vide

Bonjour,

Effectivement il recopie sur la ligne 30 si celle ci est la dernière non vide.

Le code Range("A65536").End(xlUp).Select permet de sélectionner la dernière cellule NON VIDE de la colonne A.

Pour faire ce qui est demandé :

Sub misenepage()
'
' misenepage Macro
'
Sheets("param").Select
Range("A34:G47").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("facture").Select

fin = Range("A65536").End(xlUp).Row + 1 'calcule la dernière ligne vide de la colonne A
cells(fin,1).select 'sélectionne la dernière cellule vide de la colonne A
ActiveSheet.Paste

end sub

A plus

 

[Naeva]

Re : COPIER/COLLER Tableau sauf ligne vide

Merci beaucoup ça marche nickel chrome !!!

Bon week-end à tous