Recuperation de donnees plusieurs classeurs VBA

Bonjour le forum,

Je cherche a creer une macro pour recuperer automatiquement des donnees.

Mon classeur source est different de mon classeur de destination.

En revanche, ils ont en commun un code et la meme configuration de tableaux (Lignes et colonnes).

J'ai tente d'ecrire un code a partir d'un autre (trouve sur ce forum) qui me permettait de faire la meme chose mais au sein d'un meme classeur.

Si vous avez une idee...

Ci-joint les deux classeurs

Merci bcp pour votre aide

Cdlt

84desti.zip (42.10 Ko)

Bonsoir

Les 2 fichiers dans le même répertoire (dossier)

A tester

Encore une fois un grand merci pour votre aide Banzai64

Je n'arrive cependant pas a trouver le fichier source.

Par ailleurs, comment puis-je definir un nouveau chemin dans le code?

  Application.ScreenUpdating = False

  Chemin = ThisWorkbook.Path & Application.PathSeparator
  Fichier = "D:\Documents and Settings\277204\Desktop\excel pra\source te 2014.xlsx"

  If Dir(Chemin & Fichier) = "" Then
    MsgBox "Fichier introuvable dans " & Chemin
    Exit Sub
  End If

??

Dsl pour ces questions a repetitions, je cherche a comprendre et je suis perdu dans ce vaste environnement qu'est VBA.

Merci encore

Bonsoir

Suivant le code que tu as fourni

Modifies les 2 lignes

  Application.ScreenUpdating = False

  Chemin = "D:\Documents and Settings\277204\Desktop\excel pra\"
  Fichier = "source te 2014.xlsx"

  If Dir(Chemin & Fichier) = "" Then
    MsgBox "Fichier introuvable dans " & Chemin
    Exit Sub
  End If

MErci bcp, ca marche nickel, et je commence enfin a comprendre un peu plus

2 questions:

  • Que signifie la fonction "ubounb"?
  • Comme mes donnees "rejection PVT" s'arretent en ligne 27, aucune donnee ne se charge au dela de cette ligne, meme celles qui correspondent a l'onglet "ExpRpt PVT". Comment puis-je remedier a ce pbm via VBA?
Le cas contraire, je peux toujours remplacer cellules vides par 0 pour avoir un meme nombre de ligne dans chaque onglet.

Merci

Bonsoir

repokovskixl a écrit :

Que signifie la fonction "ubounb"?

Ubound signifie limite supérieure d'un tableau

repokovskixl a écrit :

Comme mes donnees "rejection PVT" s'arretent en ligne 27,

Erreur de ma part

Modifies la ligne correspondante

  With Workbooks.Open(Chemin & Fichier)
    For I = 0 To UBound(Feuilles)
      For J = 3 To WsDestin.Range("A" & Rows.Count).End(xlUp).Row
        Set cel = .Sheets(Feuilles(I)).Columns("A").Find(what:=WsDestin.Range("A" & J), LookIn:=xlValues, lookat:=xlWhole)
        If Not cel Is Nothing Then

Bonjour

Un essai à tester.

Te convient-il ?

85desti-v1.xlsm (31.71 Ko)

Merci bcp GMB,

Ca me convient tout a fait aussi. Meme si je suis frustre de ne pas pouvoir tout comprendre.

Je reviendrais vers vous si j'ai des questions.

Que dois-je rajouter pour obtenir les donnees de l'onglet "rejected"?

Merci pour votre aide

Bonjour

Version complète avec "rejected". A tester

Bonne réception

87desti-v2.xlsm (31.95 Ko)

Bonjour @Banzai64,

J'essaye d'utiliser le code d'extraction de donnees que vous avez ecris pour d'autre fichiers.

Or je n'arrive pas a l'adapter...

Pouvez vous svp indiquer quelques commentaires sur le code suivant, m'indiquant quelle fonction fait quoi de sorte a ce que je puisse l'adapter et le reutiliser.

Merci bcp pour votre aide.

cdlt

Option Explicit

Sub Macro1() 'plusieurs onglets sources et differents classeurs
Dim Path As String, Folder As String
Dim cel As Range
Dim WsSource As Worksheet, WsDestin As Worksheet
Dim Feuilles, NbColonnes
Dim J As Long
Dim I As Integer, Colonne As Integer

  Application.ScreenUpdating = False

  Path = "P:\xxxxxxx\ 2013_2014 KPI Reporting\" 'key here the path
  Folder = "Year 2013-2014.xlsx" 'key here the folder

  If Dir(Path & Folder) = "" Then
    MsgBox "Can't find the folder in " & Path
    Exit Sub
  End If

  Feuilles = Array("Jan ExpRpt PVT", "Jan Rejection PVT", _
                "Feb ExpRpt PVT", "Feb Rejection PVT", _
                "Mar ExpRpt PVT", "Mar Rejection PVT")
  NbColonnes = Array(3, 1, 3, 1, 3, 1)
  Set WsDestin = Sheets("AR DATA")
  Colonne = 2
  With Workbooks.Open(Path & Folder)
    For I = 0 To UBound(Feuilles)
      For J = 3 To WsDestin.Range("A" & Rows.Count).End(xlUp).Row
        Set cel = .Sheets(Feuilles(I)).Columns("A").Find(what:=WsDestin.Range("A" & J), LookIn:=xlValues, lookat:=xlWhole)
        If Not cel Is Nothing Then
          cel.Offset(0, 1).Resize(1, NbColonnes(I)).Copy WsDestin.Cells(J, Colonne)
        End If
      Next J
      Colonne = Colonne + NbColonnes(I)
    Next I
    .Close savechanges:=False
  End With

  Application.ScreenUpdating = True

End Sub

Bonjour

Des commentaires dans le code

Un grand merci

Rechercher des sujets similaires à "recuperation donnees classeurs vba"