Problème boucle sur plusieurs feuilles

[ICE_SACCO]

Bonjour,

j'ai un problème dans ma macro j'aimerai répuerer tous les lignes de chaque feuille et non juste la première ligne.

Ci-dessous la macro:


Sub Assembler() 'Nom de la macro
'Eviter l'ajout des mêmes lignes erase feuille avant lancement
With Worksheets("Portefeuille Projet")
.Rows("3:65536").EntireRow.Delete
End With

'Date de dernière mise à jour

Range("D1").Value = Format(Now, "mm/dd/yyyy HH:MM") 'Date de mise à jour des données

Dim i As Long, j As Long 'Déclare deux variables numériques
Worksheets("Portefeuille Projet").Select 'Active la feuille nommée Portefeuille Projet
'Passe chaque feuille en revue en partant de la 3eme jusqu'à x

For i = 5 To Worksheets.Count - 2 'WorkSheets.Count donne le nombre total de feuilles
'j prend la valeur du numéro de ligne de la 1ere cellule vide de la colonne A
'A chaque passage dans la boucle j sera incrémentée de 1 du fait de l inscription des nouvelles données

j = Range("A65536").End(xlUp).Row + 1

With Worksheets(i)

'Sur la ligne déterminée par j, la 1ere cellule prend la valeur de la cellule A1 de la feuille dont l'index est égal à i
'Code activité
If .Range("F3").Value > "" Then
Cells(j, 1).Value = .Range("F3").Value
Else
Cells(j, 1).Value = "X"
End If
'Code projet
If .Range("E3").Value > "" Then
Cells(j, 2).Value = .Range("E3").Value
Else
Cells(j, 2).Value = "X"
End If
'Projet
If .Range("H3").Value > "" Then
Cells(j, 3).Value = .Range("H3").Value
Else
Cells(j, 3).Value = "X"
End If
'Chantier/Lot
If .Range("I3").Value > "" Then
Cells(j, 4).Value = .Range("I3").Value
Else
Cells(j, 4).Value = "X"
End If
'Mois référence
If .Range("C3").Value > "" Then
Cells(j, 6).Value = .Range("C3").Value
Else
Cells(j, 6).Value = "X"
End If
'Nombre UO Interne
If (.Range("AA3").Value + .Range("AB3").Value) > "0" Then
Cells(j, 7).Value = .Range("AA3").Value + .Range("AB3").Value
Else
Cells(j, 7).Value = "0"
End If
'Nombre UO Total
If .Range("AG3").Value > "0" Then
Cells(j, 8).Value = .Range("AG3").Value
Else
Cells(j, 8).Value = "0"
End If
'Montant
If (.Range("AH3").Value + .Range("AH3").Value) > "0" Then
Cells(j, 9).Value = .Range("AH3").Value + .Range("AH3").Value
Else
Cells(j, 9).Value = "0"
End If
'Responsable CP IDS
If (.Range("U3").Value) > "0" Then
Cells(j, 10).Value = .Range("U3").Value
Else
Cells(j, 10).Value = "0"
End If
'Année référence
If (.Range("C3").Value) > "0" Then
Cells(j, 11).Value = .Range("C3").Value
Else
Cells(j, 11).Value = "0"
End If
'Type
Cells(j, 12).Value = "D"
'N°devis
Cells(j, 13).Value = .Range("D3").Value
'Devis validé (O/N/R)
If .Range("AI3").Value > "" Then
Cells(j, 15).Value = "V"
Else
Cells(j, 15).Value = "N"
End If
'Domaine
Cells(j, 17).Value = "E00028/02/08/02"
'RAF
Cells(j, 18).Value = .Range("AL3").Value + .Range("AN3").Value + .Range("AP3").Value + .Range("AR3").Value + .Range("AT3").Value
End With
Next 'Passe à la feuille suivante

'******************** POST-TRAITEMENT ********************

'******Convertir les dates de la colonne F en mois******

Dim DerLig As Long
Dim Cel As Range
With Worksheets("Portefeuille Projet") 'Nom de feuille à adapter
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Convertir les dates de la colonne F
For Each Cel In .Range("F3:F" & DerLig)
Cel.NumberFormat = "mm"
Next
End With

'******Convertir les dates de la colonne K en année******

Dim DerLig1 As Long
Dim Cel1 As Range
With Worksheets("Portefeuille Projet") 'Nom de feuille à adapter
DerLig1 = .Range("A" & .Rows.Count).End(xlUp).Row
'Convertir les dates de la colonne K
For Each Cel1 In .Range("K3:k" & DerLig1)
Cel1.NumberFormat = "yyyy"
Next
End With


End Sub 'Fin

MErci d'avance

 

[gosselien]

Bonjour,

il est particulièrement indigeste de lire un code VBA sans avoir une copie anonymisée du fichier, mais c'est juste mon avis

P.

 

[cathodique]

Bonjour Gosselien,

Je partage ton avis. On attend un petit fichier.

@+

 

[ICE_SACCO]

Désolé oui c'est mieux.

Merci d'avance

 

[cathodique]

Franchement, je n'ai pas compris ton problème.
ce n'est pas clair.

 

[ICE_SACCO]

En fait lorsque je lance la macro elle me récupère bien chaque cellule demandée mais que de la première ligne de chaque feuille même s'il y en a plusieurs.

L'objectif est de passer sur chaque feuille et récupérer les données ciblées de chaque ligne de la feuille avant de passer à la suivante.

 

[cathodique]

Écoute ce n'est pas clair pour moi. D'autant plus que tes feuilles ne sont pas fournies en données.

tu nous dis que tu boucles sur toutes les feuilles. or avec ton code:
For i = 5 To Worksheets.Count - 2
tu as 7 feuilles sur ton fichier moins 2 ---> donne 5.
Au final c'est comme si tu avais écrit For i=5 to 5. tu ne travailles qu'avec la feuille 5.
Ensuite, tu fais un mélange entre les cellules source et destination.

Mets quelques données sur tes feuilles, et montre-nous le résultat souhaité dans une feuille à part.

 

[ICE_SACCO]

Je commence à partir de la 5 ieme feuille et je prends pas les deux dernères. Donc je prends prends autant de feuille compris entre les deux. Sur le fichier transmis j'ai supprimé une des deux dernières en voulant anonymiser mais il manque une feuille.

Pour les données j'ai mis dans la feuil Portefeuille un exemple de récupération de la feuille CA. La macro m'aurait récupéré la première ligne de la feuil CA et passé ensuite à la premiere de la feuille CH sans récuperer les autres lignes de CA et CH avec les cellules précises.

Je sais faire la récupération en masse de toutes les lignes là je lit la ligne je récupère certaine données et je dois passer à la suivantes lignes.

 

[Dranreb]

Bonjour.
Faites le avec des tableaux vba en mémoire.
Cellule par cellule ce sera extrêmement lent.

 

[cathodique]

Bonjour,

ton fichier me donne le tournis. Je ne comprends rien, je ne vois pas de correspondance entre les cellules source et destination.

peux-tu me donner pour une seule ligne de la feuille CA, la correspondance des colonnes entre CA et Portefeuille.

Je ne comprends pas ta démarche de vouloir copier cellules par cellules. Si tu as du temps à perdre c'est une autre chose.


@+

 

[cathodique]

sans retour de ta part voici une approche.
ton fichier pose un problème d'index des feuilles.
j'ai refait un fichier où tu trouveras le transfert de 3 colonnes.