Copier coller colonnes de +ieurs tableaux

[ABDELHAK]

Bonjour à tous,

Je suis enfin de retour sur le forum parce que je suis tout aussi doué en VBA que lorsque j’ai découvert votre fabuleux site. Autant dire un zéro pointé.
Je tiens, avant de vous exposer ma requête, à vous remercier pour tout ce que vous avez déjà fait pour moi. En effet, sans votre aide, je n’aurai jamais su réaliser mon rêve un peu fou. Grâce à vous, j’y suis presque arrivé.
Et pour cela, je vous serai reconnaissant jusqu’à mon dernier souffle.

Voici donc ma requête :

J’ai un fichier où en feuil2, il y a plusieurs tableaux.
Ces tableaux se composent comme suit :
La première ligne = dates
La deuxième ligne = facultatif
De la troisième à la douzième lignes = valeurs (A1, B1, C1, …, HO1) + des chiffres 1 sur fond vert
Treizième ligne = la somme des colonnes B à HX des lignes 3 à 12
Et il y a plusieurs tableaux du même type sur toute la feuille (de la ligne 6 à la ligne 438)

J’aimerais que la macro cherche à la ligne où se trouvent les sommes. Si la cellule = 10 alors exécuter un copier coller de la colonne comme décrit ci-dessus et les valeurs de la colonne A correspondant au tableau en bas de la feuille.
Et exécuter la même procédure sur toute la feuille.

Je joins un fichier qui vous aidera à mieux comprendre ma requête, du moins, c’est mon souhait.

En espérant avoir été complet, je vous remercie d’avance pour l’attention que vous y accorderai.

Amicalement,

Abdelhak

 

[job75]

Re : Copier coller colonnes de +ieurs tableaux

Bonjour ABDELHAK,

Voyez le fichier joint et cette macro :

Sub Somme_10()
Dim premlig&, derlig&, dercol%, col%, i&, j%
premlig = [A:A].Find("EMPLACEMENTS", , xlFormulas).Row
derlig = Cells.Find("*=*", , , , xlByRows, xlPrevious).Row
dercol = ActiveSheet.UsedRange.Columns.Count
col = -2
Application.ScreenUpdating = False
Rows(derlig + 4 & ":" & Rows.Count).Delete 'RAZ
Rows(premlig).Resize(13).Copy Cells(derlig + 4, 1) 'pour hauteur lignes
Rows(derlig + 4).Resize(13).Clear
For i = premlig + 12 To derlig Step 15
  For j = 1 To dercol
    If Cells(i, j) = 10 And IsDate(Cells(i - 12, j)) Then
      col = col + 3
      Cells(i - 12, 1).Resize(12).Copy Cells(derlig + 4, col)
      Cells(i - 12, j).Resize(13).Copy Cells(derlig + 4, col + 1)
    Cells(derlig + 16, col + 1) = Cells(derlig + 16, col + 1)
    End If
  Next
Next
End Sub

Edit : ajouté le test IsDate(Cells(i - 12, j)).

A+

 

[job75]

Re : Copier coller colonnes de +ieurs tableaux

Re,

En fait comme le souligne CISCO sur l'autre fil (en doublon), il suffit de lister les dates :

Sub Somme_10()
Dim premlig&, derlig&, dercol%, i&, j%, mes$
premlig = [A:A].Find("EMPLACEMENTS", , xlFormulas).Row
derlig = Cells.Find("*=*", , , , xlByRows, xlPrevious).Row
dercol = ActiveSheet.UsedRange.Columns.Count
For i = premlig + 12 To derlig Step 15
  For j = 1 To dercol
    If Cells(i, j) = 10 And IsDate(Cells(i - 12, j)) Then _
      mes = mes & vbLf & CDate(Cells(i - 12, j))
  Next
Next
MsgBox IIf(mes = "", "Aucune date", "Dates :" & mes), , "Somme = 10"
End Sub

Edit : ajouté le test IsDate(Cells(i - 12, j)).

Fichier (2).

A+

 

[job75]

Re : Copier coller colonnes de +ieurs tableaux

Re,

Et au lieu de 10 on peut rechercher la somme que l'on veut :

Sub Somme_n()
Dim n, premlig&, derlig&, dercol%, i&, j%, mes$
n = Int(Abs(Val(InputBox("Entrez un nombre de 0 à 10", "Somme"))))
If n > 10 Then n = 10
premlig = [A:A].Find("EMPLACEMENTS", , xlFormulas).Row
derlig = Cells.Find("*=*", , , , xlByRows, xlPrevious).Row
dercol = ActiveSheet.UsedRange.Columns.Count
For i = premlig + 12 To derlig Step 15
  For j = 1 To dercol
    If Cells(i, j) = n And IsDate(Cells(i - 12, j)) Then _
      mes = mes & vbLf & CDate(Cells(i - 12, j))
  Next
Next
MsgBox IIf(mes = "", "Aucune date", "Dates :" & mes), , "Somme = " & n
End Sub

Fichier (3).

A+

 

[ABDELHAK]

Re : Copier coller colonnes de +ieurs tableaux

Bonjour Mr job75 et Mr CISCO

10000000000 merci……….iss et bravo. La macro tourne parfaitement.
Et encore merci pour votre aide.

A bientôt

Amicalement vôtre

ABDELHAK

 

[job75]

Re : Copier coller colonnes de +ieurs tableaux

Re,

Pour le fun une version avec un UserForm et sélection des dates :

Dim n, dat$(), pos& 'mémorise les variables

Private Sub CommandButton1_Click() '1ère date
Dim premlig&, derlig&, dercol%, i&, j%, d&
n = Int(Abs(Val(TextBox1)))
If n > 10 Then n = 10
TextBox1 = n
premlig = [A:A].Find("EMPLACEMENTS", , xlFormulas).Row
derlig = Cells.Find("*=*", , , , xlByRows, xlPrevious).Row
dercol = ActiveSheet.UsedRange.Columns.Count
For i = premlig + 12 To derlig Step 15
  For j = 1 To dercol
    If Cells(i, j) = n And IsDate(Cells(i - 12, j)) Then
      d = d + 1
      ReDim Preserve dat(1 To d)
      dat(d) = Cells(i - 12, j).Resize(13).Address
    End If
  Next
Next
pos = 0
If d = 0 Then MsgBox "Aucune date", , "Somme = " & n: GoTo 1
pos = 1
Application.Goto Range(dat(1)), True
1 TextBox1.SetFocus: TextBox1.SelStart = 0: TextBox1.SelLength = 2
End Sub

Private Sub CommandButton2_Click() 'Suivante
If pos = 0 Then GoTo 1
TextBox1 = n
If pos = UBound(dat) Then pos = 0
pos = pos + 1
Application.Goto Range(dat(pos)), True
1 TextBox1.SetFocus: TextBox1.SelStart = 0: TextBox1.SelLength = 2
End Sub

Private Sub CommandButton3_Click() 'Précédente
If pos = 0 Then GoTo 1
TextBox1 = n
pos = pos - 1
If pos = 0 Then pos = UBound(dat)
Application.Goto Range(dat(pos)), True
1 TextBox1.SetFocus: TextBox1.SelStart = 0: TextBox1.SelLength = 2
End Sub

Fichier (4).

A+

 

[job75]

Re : Copier coller colonnes de +ieurs tableaux

Re,

Une solution plus élaborée avec la propriété Enabled à False par défaut et par :

Private Sub TextBox1_Change()
CommandButton2.Enabled = False 'désactivation du bouton
CommandButton3.Enabled = False 'désactivation du bouton
End Sub

Fichier (5).

A+

 

[job75]

Re : Copier coller colonnes de +ieurs tableaux

Bonjour le fil, le forum,

Une dernière amélioration avec le contrôle des touches dans TextBox1 :

Private Sub TextBox1_KeyPress(ByVal KeyANSI As MSForms.ReturnInteger)
'touches S ou P pour faire défiler
If KeyANSI = 115 Or KeyANSI = 112 Then _
  If CommandButton2.Enabled Then If KeyANSI = 115 Then _
    CommandButton2_Click Else CommandButton3_Click
If KeyANSI < 48 Or KeyANSI > 57 Then KeyANSI = 0
End Sub

Les touches S ou P font défiler la feuille.

Fichier (6).

A+

 

[ABDELHAK]

Re : Copier coller colonnes de +ieurs tableaux

bonjour job75,

je viens de remarquer que vous avez rajouter une boite de dialogue et elle fonctionne parfaitement.
je n'y avais même pensé.
merci de l'avoir fait pour moi.
c'est trop top.
des milliers de merci

amicalement vôtre

abdelhak