PDA

View Full Version : Repetition de de copier/coller avec saut de ligne



JerSingap
03-15-2013, 12:43 AM
Bonjour a tous,

Je suis debutant en matiere de VBA et je lutte un peu pour arriver a faire ce que je veux:

Voici la situation:
Une Feuille "Resultat": J'ai un nom d’équipement et le reste des info a remplir avec d'autres onglets.
Les infos sont du type « ancien» , « actuel « date de changement, « ...

Exemple d’onglet « Source» :
Je veux copier les informations dans les case correspondante a l'equipement dans la feuille resultat
-La 1ere ligne d'info va dans une ligne et la suivante doit se positionner 18 lignes plus bas puis recommencer l’action jusqu'a la ligne 329 de la feuille « Source»

J'ai reussi a faire l'action de copie:

Sub COPIERPLAGE()
Dim Maplage As Range
With ThisWorkbook.Worksheets("Source")
Set Maplage = .Range("C4:G4")
End With
Maplage.copy
ActiveSheet.Paste Destination:=Worksheets("Resultat").Range("D26")
Application.CutCopyMode = False

End Sub



Maintenant je souhaite répéter cette action jusqu'a la ligne 329 de l'onglet source et en sautant 18 lignes a chaque fois (dans l'onglet resultat).

Est ce que quelqu'un pourrai me depanner?

Merci d'avance,

Cordialement,
Jerome

snb
03-15-2013, 01:57 AM
Sub M_snb()
for j=4 to 329 step 18
ThisWorkbook.Worksheets("Source").Range("C4:G4").offset(j).copy sheets("Resultat").Range("D26").offset(j\18)
next
End Sub

PS. On parle français a Singapore ?

JerSingap
03-15-2013, 02:56 AM
Thank you but it doesn't work, I don't understand why.

snb
03-15-2013, 03:47 AM
Sub M_snb()
For j=0 To 329 Step 18
ThisWorkbook.sheets("Source").Range("C4:G4").offset(j).copy thisworkbook.sheets("Resultat").Range("D26").offset(j\18)
Next
End Sub

NB posting a sample file will do wonders....

JerSingap
03-22-2013, 01:01 AM
Hello everybody,

I have never succed to adapt the previous code on my file, but I find something which work perfectly. I post it if someone need it:

Sub COPY_Entity()
Dim y As Integer
Worksheets("source").Activate
For y = 2 To Range("A65536").End(xlUp).Row Step 1
Worksheets("source").Activate
Cells(y + 1, 2).Select
Selection.copy
Worksheets("Result").Activate
Cells(2 + (y - 2) * 18, 2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Next y
End Sub


See U later