VBA Résolu

Question

Bonjour,  

Mon objectif est de transférer les données de la colonne B à D de la feuille origine vers la feuille de destination le problème c'est que entre certaines lignes il y a des vides et le vba croit que c'est la dernière ligne alors que non et je ne sais que faire ? 

Sub transfert() 


Const NomFO = "feuille1" 
Const NomFD = "test" 

Const CellD = "B5" 

Dim lifin As Long 

lifin = Range("B" & Rows.Count).End(xlUp).Row 

Sheets(NomFO).Range("B4:D" & lifin).Copy Sheets(NomFD).Range(CellD) 


End Sub

merci d'avance

pijaku · Answer

Bonjour,

Peut être effectivement que votre colonne B n'est pas la plus "longue"...
Pour éviter cela, vous pouvez trouver la dernière ligne absolue non vide dans la feuille.	
Attention toutefois, si des lignes sont supprimées dans la plage, enregistrez préalablement le fichier pour que la procédure renvoie la réelle dernière ligne	
Code à utiliser :
Dim lifin As Long
ActiveWorkBook.Save 'pour contourner le problème de suppression de ligne
lifin = Range("A1").SpecialCells(xlCellTypeLastCell).Row

Tout, tout, tout vous saurez tout sur ... la dernière ligne!

pijaku · Answer

Je n'ai pas compris :
c'est que ça ne copie pas tout d'un seul coup, je suis obligé de cliquer sur mon bouton vba pour que le copier coller se fasse jusqu'à la fin 
Merci de bien détailler ce que vous souhaitez faire et le(s) problème(s) que vous rencontrez...

pijaku · Answer

le code communiqué ci dessus doit faire ce que tu souhaites.
C'est dans l'exécution que cela pose souci.
Qu'entends tu par : je suis obligé de cliquer sur mon bouton vba

pijaku · Answer

Peux tu nous transférer ton fichier sans données confidentielles?
Pour cela utilises https://www.cjoint.com/ et reviebns ici coller le lien fournit dans une réponse...

pijaku · Answer

Donc, une fois ton problème de "tout copier" résolu, tu nous demandes de résoudre un souci de copier/coller ligne par ligne......................................

Essaye ceci :
Sub copiercoller()
Const NomFO = "Feuil1"
Const NomFD = "test"
Dim lifin As Long, i As Long, j As Long

j = 5 'pour commencer à la cellule B5
ActiveWorkbook.Save
lifin = Range("A1").SpecialCells(xlCellTypeLastCell).Row
For i = 1 To lifin
    If UCase(Sheets(NomFO).Range("E" & i)) = "X" Then
        Sheets(NomFO).Range("B" & i & ":D" & i).Copy Sheets(NomFD).Range("B" & j)
        j = j + 1
    ElseIf Sheets(NomFO).Range("E" & i) <> "X" Then
        'ben ici je ne fais rien. Ok?
    End If
Next i
End Sub

pijaku · Answer

Bonjour,
j'ai essayé avec votre code mais rien ne se passe
Dans mon code, la ligne de test est :
If UCase(Sheets(NomFO).Range("E" & i)) = "X" Then
Traduit en "pseudo français" :
Si la mise en majuscule de la cellule E ligne i est égale à X majuscule alors...

S'il ne se passe rien, peut être que la cellule E ligne i n'est pas égale à "X"....

Envoie moi un exemple de ton fichier sans données confidentielles, en passant par cjoint.com

pijaku · Answer

dernière tentative, après il FAUDRA le fichier...
Sub copiercoller()
Dim lifin As Long, i As Long, j As Long

j = 5 'pour commencer à la cellule B5
ActiveWorkbook.Save
lifin = Sheets("Feuil1").Range("A1").SpecialCells(xlCellTypeLastCell).Row
For i = 1 To lifin
    If Sheets("Feuil1").Range("E" & i).Value = "X" Then
        Sheets("Feuil1").Range("B" & i & ":D" & i).Copy Sheets("test").Range("B" & j)
        j = j + 1
    End If
Next i
End Sub

VBA

7 réponses

Discussions similaires

Newsletters