Copie de plusieurs plage de données vers une seule feuille
P
Bonjour à tous,
je suis novice en VBA est je cherche à centralisé toute les données dans un seul fichier excel. J'arrive à copier-coller les cellules uniques mais j'ai un problème lors de la copie d'une plage de donnée. En effet, il ne copie que la plage du premier fichier (premier classeur, première feuille).
Voici le code que j'utilise pour copier la plage:
'copie nom
COL = 1 'colonne A
OD.Cells(1, COL) = "Nom site"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(7, 0))
OS.Range("B5").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie tableau jarretière RJ
COL = 3 'colonne C
OD.Cells(1, COL) = "Tableau jarretière RJ"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(7, 0))
OS.Range("H10:J13").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)Le code suivant est le complet mais je pense que le problème vient du code du dessus:
'Sub principale récupérant toute les données.
Sub RemplissageInventaire()
Dim CD As Workbook 'déclare la variable CD (Claseur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichiers)
Dim CS As Workbook 'déclare la variable CS (Claseur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim NFS As Integer 'déclare la variable NFS (nombre feuille source)
Dim CF As Integer 'déclare la variable CF (compteur feuille)
Dim COL As Integer 'déclare la variable COL (colonne
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
'nettoyage des feuilles
Set OD = CD.Sheets("Inventaire") 'définit l'onglet destination OD
OD.Cells.Clear
Set OD = CD.Sheets("Tableau Inventaire") 'définit l'onglet destination OD
OD.Cells.Clear
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xlsx") 'définit le premier fichier F avec l'extension ".xlsx" dans le dossier CA
Do While F <> "" 'exécute tant qu'il existe des fichiers F
Application.Workbooks.Open (CA & F) 'ouvre le fichier F
Set CS = ActiveWorkbook 'définit le classeur source CS
NFS = CS.Sheets.Count 'récupère le nombre de feuille à traiter
For CF = 1 To NFS 'parcour des feuilles
Set OS = CS.Sheets(CF) 'définit l'onglet source OS
If OS.Name <> "data" And OS.Name <> "Fiche type " Then 'on exclu la feuille data et fiche type
Set OD = CD.Sheets("Inventaire") 'définit l'onglet destination OD, dans un premier temps inventaire
'copie du nom du site
COL = 1 'colonne A
OD.Cells(1, COL) = "Nom site" 'nom du champ
'définit la cellule de destination DEST (A2, si A2 est vide, sinon, la première cellule vide de la colonne A de l'onglet OD)
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("B5").Copy 'copie du nom du site
DEST.PasteSpecial (xlPasteValuesAndNumberFormats) 'renvoie dans DEST les valeurs et les formats de nombre de la plage copiée
'copie de la date de visite
COL = 2 'colonne B
OD.Cells(1, COL) = "Date visite"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("B2").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie du redacteur
COL = 3 'colonne C
OD.Cells(1, COL) = "Redacteur"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("E2").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie du referent DMET
COL = 4 'colonne D
OD.Cells(1, COL) = "Referent DMET"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("H2").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie de l'autoroute
COL = 5 'colonne E
OD.Cells(1, COL) = "Autoroute"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("B6").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie des PR
COL = 6 'colonne F
OD.Cells(1, COL) = "PR"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("B7").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie du sens
COL = 7 'colonne G
OD.Cells(1, COL) = "Autoroute"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("B8").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie du site géré par ATC
COL = 8 'colonne H
OD.Cells(1, COL) = "Site géré par ATC"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("B9").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie N° site TETRA
COL = 9 'colonne I
OD.Cells(1, COL) = "N° site TETRA"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("B10").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie Presence TETRA
COL = 10 'colonne J
OD.Cells(1, COL) = "Présence TETRA"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("B11").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie site FH Pt bas
COL = 11 'colonne K
OD.Cells(1, COL) = "Site FH Pt bas"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("D11").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie site FH Pt Haut
COL = 12 'colonne L
OD.Cells(1, COL) = "Site FH Pt haut"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("F11").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie Presence 107.7
COL = 13 'colonne M
OD.Cells(1, COL) = "Présence 107.7"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("B12").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie N° site 107.7
COL = 14 'colonne N
OD.Cells(1, COL) = "N° site 107.7"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(1, 0))
OS.Range("B13").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'--------------------------------------------------------------------------------------------------------------------------
Set OD = CD.Sheets("Tableau Inventaire") 'définit l'onglet destination OD, on traite les tableaux
'copie nom
COL = 1 'colonne A
OD.Cells(1, COL) = "Nom site"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(7, 0))
OS.Range("B5").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
'copie tableau jarretière RJ
COL = 3 'colonne C
OD.Cells(1, COL) = "Tableau jarretière RJ"
Set DEST = IIf(OD.Cells(2, COL).Value = "", OD.Cells(2, COL), OD.Cells(Application.Rows.Count, COL).End(xlUp).Offset(7, 0))
OS.Range("H10:J13").Copy
DEST.PasteSpecial (xlPasteValuesAndNumberFormats)
End If
Next
CS.Close SaveChanges = False 'ferme le fichier source sans enregister les changements
F = Dir 'fichier suivant avec l'extension ".xlsx" dans le dossier CA
Loop 'boucle
CD.Save 'enregistre le fichier destination
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
'MsgBox "Fin du traitement des données !" 'message
'Se place sur la feuille nommée Inventaire
Sheets("Inventaire").Activate
End SubPourriez vous m'aider?
P
J'ai trouvé mon erreur,
La première case de mon tableau (1:1) est vide dans tous les cas, donc a chaque fois il réécris par dessus le tableau précédent puisqu'il détecte un vide.