XL 2016 resumer code vba

[lamho27]

bonjour a tous
j'ai une code vba integer mais trop long , pouvez-vous me modifier pour simplement mon code; merci d'avance
Sub Button()
Dim j As Integer
j = 1
For i = 1 To 40
If Not IsEmpty(Range("B" & i).Value) Then
Range("H" & j + 1).Value = Range("B" & i).Value
j = j + 1
End If
Next i
j = 1
For i = 1 To 40
If Not IsEmpty(Range("C" & i).Value) Then
Range("I" & j + 1).Value = Range("C" & i).Value
j = j + 1
End If
Next i
j = 1
For i = 1 To 40
If Not IsEmpty(Range("D" & i).Value) Then
Range("J" & j + 1).Value = Range("D" & i).Value
j = j + 1
End If
Next i
j = 1
For i = 1 To 40
If Not IsEmpty(Range("E" & i).Value) Then
Range("K" & j + 1).Value = Range("E" & i).Value
j = j + 1
End If
Next i
j = 1
For i = 1 To 40
If Not IsEmpty(Range("F" & i).Value) Then
Range("L" & j + 1).Value = Range("F" & i).Value
j = j + 1
End If
Next i
j = 1
For i = 1 To 40
If Not IsEmpty(Range("G" & i).Value) Then
Range("M" & j + 1).Value = Range("G" & i).Value
j = j + 1
End If
Next i
End Sub

 

[Staple1600]

Bonjour mapomme

C'est la même méthode, non?

'[B1:G32].Copy: Cells(Rows.Count, "H").End(xlUp)(2).PasteSpecial -4104
.Range("B:G").Copy .Range("H:M")
.Range("H:M").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
'idem:Selection.SpecialCells(4).Delete -4162

Sauf que tu copies les colonnes entières

@lamho27
On se sait pas comment est alimentée la plage B1:G32.
Est-ce qu’après la recopie, elle est effacée manuellement?
Et qu'ensuite tu y saisis de nouvelles dates?

 

[mapomme]

Bonjour lamho27 ,

As tu vu le message #14 de ma pomme ?

 

[lamho27]

Bonjour mapomme
merci ton code ; très bien que je veux

 

[mapomme]

Bonjour Staple1600 ,

C'est la même méthode, non?
Sauf que tu copies les colonnes entières

Tout à fait, c'est ça la différence qui justifie "une autre manière". Il m'en faut peu

 

[Staple1600]

Re mapomme

Tu peux m'expliquer le pourquoi de ta boucle, stp?
For i = 1 To .Rows.Count
If Application.WorksheetFunction.Count(.Range("h" & i & ":m" & i)) = 0 Then Exit For
Next i

(Je suis pas encore bien réveillé )

EDITION:
Il me manquait juste cette ligne, si j"ai bien compris

Sub aa()
Application.ScreenUpdating = False
If Len([H2]) > 0 Then Exit Sub
[B1:G32].Copy: [H2].PasteSpecial Paste:=xlPasteAll, SkipBlanks:=True
Selection.SpecialCells(4).Delete -4162: [H2].Select
End Sub

 

[mapomme]

Re Staple1600 ,

Maintenant que tu es redevenu visible...

Je recherche simplement la première ligne i entièrement vide des colonnes h à m pour appliquer aux lignes 1 à (i-1) l'encadrement pointillé. C'est pas optimisé mais ça le fait .

 

[mapomme]

Re Staple1600 ,

Une autre petite différence, me semble-t-il, est que ma macro prend en compte les modifications du tableau source entre deux exécutions. Ta macro, une fois exécutée, ne retraite pas les données sources ( du moins, il me semble).

 

[Staple1600]

Re

@mapomme
Je suis pas réveillé avais-je dit
De quelle visibilité, tu parles?

C'est normal, le dimanche, mes macros ne se lancent qu'une fois!
C'est un jour de repos.

 

[mapomme]

Re,

De quelle visibilité, tu parles?

Il m'avait semblé avoir lu deux fils de discussions assez récents où tes réponses semblaient invisibles ...

 

[vgendron]

Hello le forum
bizarre effectivement, ma proposition ne fonctionne pas sur le fichier posté par Lamho27, lequel contient des dates

alors que ca fonctionnait bien sur le fichier que je m'étais créé et qui ne contenait que des chiffres...
cf feuille2 du classeur

sans doute qu'excel n'aime pas la correspondance xlcelltypeconstant avec des dates....