XL 2010 Copier et decaler plage variable vers le bas avec incrementation

kariboox

XLDnaute Nouveau
Bonjour,

J'ai un petit souci de code vba et je ne trouve pas la solution convenable sur les forums.

But de l'opération : Copier le tableau C1:AC34 (qui peut avoir un nombre de lignes variable) pour chacune des températures allant de -20 à +45°C (en gros, copier le tableau initial 65 fois (1 ligne vide entre chaque tableau copié), de -20 à 45 en incrémentant les températures de +1 en colonne B)

Voici le code que j'ai commencé :
Code:
Sub tempp()

Dim RDP As Worksheet
Set RDP = Sheets("Ripage des pinces")

'Dim prl As Long
Dim drl As Long

'prl = RDP.Range("C10").End(xlDown).Row
drl = RDP.Range("C" & Rows.Count).End(xlUp).Row

Dim Tmp As Range
Set Tmp = RDP.Range("B11:B" & drl)

Dim Wink As Range
Set Wink = RDP.Range("B" & prl & ":AC" & drl)

Dim Butee As Integer
Butee = Tmp.Rows.Count

Dim Vt As Integer
Dim t As Long
For t = -20 To 45


Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial


Next t


End Sub

Le code est censé copier 65 fois le tableau précédent en haut, en incrémentant la valeur en colonne B (-20, -19, -17, ... 44, 45).
Le nombre de lignes du initial peut varier, d'ou (drl = RDP.Range("C" & Rows.Count).End(xlUp).Row) - repérage de la dernière ligne.

Ci joint le fichier avec l'onglet isolé

Pouvez vous m'éclairer sur le sujet des copie plage (en laissant 1 ligne vide entre les plages copiées) avec incrément des valeurs d'en face svp.

D'avance merci :)
 

Pièces jointes

  • pinces.xlsm
    36.8 KB · Affichages: 57

vgendron

XLDnaute Barbatruc
Re : Copier et decaler plage variable vers le bas avec incrementation

hello

code à lancer avec UNIQUEMENT le premier tableau '-20

Code:
Sub tempp()
Application.ScreenUpdating = False

Dim RDP As Worksheet
Set RDP = Sheets("Ripage des pinces")

Dim prl As Long
Dim drl As Long

prl = RDP.Range("C10").End(xlDown).Row
drl = RDP.Range("C" & Rows.Count).End(xlUp).Row

Dim Tmp As Range
Set Tmp = RDP.Range("C11:AC" & drl)

'Dim Wink As Range
'Set Wink = RDP.Range("B11" & ":AC" & drl)

'Dim Butee As Integer
'Butee = Tmp.Rows.Count

Dim Vt As Integer
Dim t As Long
For t = -20 To 44
        Tmp.Copy Destination:=Cells(Rows.Count, "C").End(xlUp).Offset(2, 0)
        Cells(Rows.Count, "B").End(xlUp).Offset(2, 0).Resize(drl - prl + 1) = t + 1
        
Next t
Application.ScreenUpdating = True

End Sub
 

kariboox

XLDnaute Nouveau
Re : Copier et decaler plage variable vers le bas avec incrementation

ReBonjour,


Donc j'ai avancé dans mon exercice, et je bute sur le problème suivant :



Ci dessous le code de vgendron que j'ai adapté pour copier le tableau2 de l'onglet suivant selon le nbre de ligne variable du tableau1.
Le tableau2 se duplique bien selon le nbre de lignes présentes du tableau1 (avec For i = 1 To nPyl), seulement je ne parviens pas à insérer la valeur de chaque ligne appartenant à la colonne C du tableau1 dans la case E13 du tableau2.

Code:
Sub FDP()

Application.ScreenUpdating = False

Dim FDP As Worksheet
Set FDP = Sheets("Fleches de pose")

Dim prl As Long
Dim drl As Long

prl = FDP.Range("C10").End(xlDown).Row
drl = FDP.Range("C" & Rows.Count).End(xlUp).Row

Dim Tableau As Range
Set Tableau = FDP.Range("B9:AB90")

'Tmp.Select
Dim nPyl As Integer
Dim pyl As String


'comptage nbre de supports à copier
drl = Sheets("Ripage des pinces").Range("C14").End(xlDown).Row
'pyl = Sheets("Ripage des pinces").Range("C14").End(xlDown).Value
nPyl = Sheets("Ripage des pinces").Range("C14:C" & drl).Rows.Count

For i = 1 To nPyl

Tableau.Copy Destination:=Cells(Rows.Count, "B").End(xlUp).Offset(2, 0)

'Cells(pyl, "E").End(xlUp).Offset(2, 0) = i



Next i

Application.ScreenUpdating = True
End Sub


Voici en PJ l'exercice en question.

Grand merci d'avance :)
 

Pièces jointes

  • pinces2.xlsm
    58.4 KB · Affichages: 49

vgendron

XLDnaute Barbatruc
Re : Copier et decaler plage variable vers le bas avec incrementation

Hello

Avec ce code 'épuré'
suppose que le tableau 1 ne bouge pas, sinon, il faudra jouer avec les indices prl, drl etc etc

Code:
Sub FDP()
Dim FDP As Worksheet
Dim prl As Long
Dim drl As Long
Dim Tableau As Range
Dim nPyl As Integer
Dim pyl As String

Application.ScreenUpdating = False

Set FDP = Sheets("Fleches de pose")
Set Tableau = FDP.Range("B9:AB90")

prl = FDP.Range("C10").End(xlDown).Row


'comptage nbre de supports à copier
drl = Sheets("Ripage des pinces").Range("C14").End(xlDown).Row

nPyl = Sheets("Ripage des pinces").Range("C14:C" & drl).Rows.Count
For i = 1 To nPyl
    DebTableau = Cells(Rows.Count, "B").End(xlUp).Offset(2, 0).Row
    Tableau.Copy Destination:=Cells(Rows.Count, "B").End(xlUp).Offset(2, 0)
    Cells(DebTableau + 4, "E") = Cells(i + 13, "C")
Next i

Application.ScreenUpdating = True
End Sub

Note: la formule qui recopie le N° support de début pour chaque phase (médiane droite...) est bien recopiée. sauf que la colonne K, P,U etc etc. sont groupées (signe +)

note: la formule "Poids du cable graisse donne une erreur de ref.. il faut la corriger dans la table d'origine feuille "Flèches de pose"
 

kariboox

XLDnaute Nouveau
Re : Copier et decaler plage variable vers le bas avec incrementation

Merci pour la réponse, seulement le tableau se copie 1 fois en surplus (ou plutôt tableau original + nb de tableaux selon nbre de lignes), s'il y a 3 lignes ds le tableau1 source, on se retrouve avec 4 tableau au lieu de 3.
Et la cellule E13 ne prend pas la valeur respectif des "Numéro de support" en tableau1


Ci joint le fichier avec les onglets isolés par souci de limite de taille sur excel-downloads, d’où les #REF etc, car le fichier de base fait 7Mo.

Dans ce fichier j'ai modifié légèrement le code :
Code:
Dim FDP As Worksheet
Set FDP = Sheets("Fleches de pose")
Dim RDP As Worksheet
Set RDP = Sheets("Ripage des pinces")

Dim prl As Long
Dim drl As Long
Dim derl As Long

prl = RDP.Range("C14").End(xlDown).Row
derl = FDP.Range("C" & Rows.Count).End(xlUp).Row
drl = RDP.Range("C" & Rows.Count).End(xlUp).Row

Dim Tableau As Range
Set Tableau = FDP.Range("B9:AB90")

'Tmp.Select
Dim nPyl As Integer


Dim pyl As Variant
Dim TabRDP As Range
Set TabRDP = RDP.Range("C14:C" & prl)
Dim sup As Range
'comptage nbre de supports à copier
nPyl = RDP.Range("C14:C" & drl).Rows.Count
Set sup = FDP.Range("E" & derl).Offset(-77, 0)

For Each pyl In TabRDP
sup = pyl
Tableau.Copy Destination:=Cells(Rows.Count, "B").End(xlUp).Offset(2, 0)
Next pyl

Là la macro a l'air de bien réagir, sauf le tableau2 de référence 'onglet "Fleches de pose" qui se retrouve "en trop" et qui ne prend pas la valeur "62N" en E13.

Je pense qu'il y a un souci dnas ce bloc :
Code:
For Each pyl In TabRDP
sup = pyl
Tableau.Copy Destination:=Cells(Rows.Count, "B").End(xlUp).Offset(2, 0)
Next pyl
qui ne considère que la partie "copiage" et non la conservation/modif E13 du tableau Tableau.
 

Pièces jointes

  • pince3.xlsm
    122.5 KB · Affichages: 58

Discussions similaires

Statistiques des forums

Discussions
312 345
Messages
2 087 450
Membres
103 546
dernier inscrit
mohamed tano