Macro et recopie de cellules

[Julie-F]

J'ai lu avec beaucoup d'attention les differents messages postés sur le sujet.

Ici https://www.excel-downloads.com/threads/recherche-dans-plusieurs-fichiers.72998/ ou encore https://www.excel-downloads.com/threads/un-grand-besoin-de-vos-lumieres.81790/

Je travaille sur des fichiers que je n'ai pas créé mais dont je dois extraire un certain nombre de valeurs (cellules) pour en donner une vision plus analytique.

J'ai donc essayé les différentes macro que vous proposiez mais c'est du chinois pour moi . Si quelqu'un pouvait m'apporter son aide.

 

[Staple1600]

Re : Macro et recopie de cellules

Bonsoir


A titre d'exemple (pour explications)

Sub test()
Dim r As Range
'ici on définit la plage de cellule
Set r = Range(Cells(1, 2), Cells(65536, 2).End(xlUp))
For Each Cell In r
'ici on étudie les deux caractères de gauche de la cellule
Select Case Left(Cell, 2)
Case "11"
' si on trouve 11 on affiche l'adresse de la cellule
MsgBox Cell.Offset(1, 1).Address
MsgBox Cell.Offset(2, 1).Address
Case "18"
'idem
MsgBox Cell.Offset(0, 1).Address
MsgBox Cell.Offset(0, 2).Address
Case "23"
'idem
MsgBox Cell.Offset(1, 1).Address
MsgBox Cell.Offset(2, 1).Address
Case "57"
'idem
MsgBox Range(Cell.Offset(0, 1), Cell.Offset(2, 1)).Address
MsgBox Cell.Offset(0, 2).Address
End Select
Next
End Sub

Cette macro ne copie pas, mais affiche l'adresse des cellules recherchées

 

[Staple1600]

Re : Macro et recopie de cellules

Re


En ajoutant la recopie dans l'onglet souhaits

Sub testII()
Dim r As Range
Dim r2 As Range
'ici on définit la plage de recopie
Set r2 = Sheets("souhaits").Cells(16, 2)
Set r = Range(Cells(1, 2), Cells(65536, 2).End(xlUp))
Application.ScreenUpdating = False
For Each Cell In r
Select Case Left(Cell, 2)
Case "11"
Cell.Offset(1, 1).Copy Destination:=r2
Cell.Offset(2, 1).Copy Destination:=r2.Offset(0, 1)
Case "18"
Cell.Offset(0, 1).Copy Destination:=r2.Offset(0, 2)
Cell.Offset(0, 2).Copy Destination:=r2.Offset(0, 3)
Case "23"
Cell.Offset(1, 1).Copy Destination:=r2.Offset(0, 4)
Cell.Offset(2, 1).Copy Destination:=r2.Offset(0, 5)
Case "57"
Cell.Offset(0, 1).Copy Destination:=r2.Offset(0, 6)
Cell.Offset(0, 2).Copy Destination:=r2.Offset(0, 7)
Cell.Offset(1, 1).Copy Destination:=r2.Offset(0, 8)
Cell.Offset(2, 1).Copy Destination:=r2.Offset(0, 9)
End Select
Next
[COLOR="Blue"]With Sheets("souhaits").Range("B16:K16")[/COLOR].Copy
    .PasteSpecial xlValues, xlNone, False, False
    .Columns.AutoFit
    .Interior.ColorIndex = xlNone
End With
End Sub

On peut remplacer les mots en bleus par:
With Range(r2, r2.Offset(0, 9))

Puisque qu'on a désigné la plage de cellule r2
Maintenant cette macro ne traite que le classeur en cours.

En espérant que mes explications n'auront pas été des chinoiseries

 

[Julie-F]

Re : Macro et recopie de cellules

Merci beaucoup Staple1600, ces explications sont claires.
Je vais tout de suite essayer mais la recopie de cellules doit imperativement se faire dans un nouveau classeur.
Pensez vous que la macro puisse fonctionner sans être obligée de recopier dans la formule l'ensemble des noms des onglets ?

 

[Julie-F]

Re : Macro et recopie de cellules

Malgre vos explications et l'aide sur différents post, un message d'erreur apparait lors de l'execution de la macro (lecture des différents onglets)

Je joins un zip contenant un exemple de fichier source et un fichier dans lequel je voudrais recopier les valeurs de 8 fichiers sources identiques dans la conception.

J'ignore si ma demande est claire ou pas............. mais je n'y arrive pas.

 

[moustic54]

Re : Macro et recopie de cellules

Malgre vos explications et l'aide sur différents post, un message d'erreur apparait lors de l'execution de la macro (lecture des différents onglets)

Je joins un zip contenant un exemple de fichier source et un fichier dans lequel je voudrais recopier les valeurs de 8 fichiers sources identiques dans la conception.

J'ignore si ma demande est claire ou pas............. mais je n'y arrive pas.

Bonjour Julie-F, je suis dans le même cas que toi.

COPIER DES CELLULES DE FICHIERS AVEC NB FEUILLES DANS UN NOUVEAU FICHIER

Nul en macro, je pense que c'est possible d'automatiser ces fastidieux copier / coller surtout lorsque la recopie d'infos porte sur une telle quantités de cellules.

Mais je ne sais pas faire donc si tu réussis à obtenir UN RESULTAT, je suis preneur de ta macro.

Merci d'avance pour un "neo-excelien" !

 

[Julie-F]

Re : Macro et recopie de cellules

Bonjour Julie-F, je suis dans le même cas que toi.

COPIER DES CELLULES DE FICHIERS AVEC NB FEUILLES DANS UN NOUVEAU FICHIER

Nul en macro, je pense que c'est possible d'automatiser ces fastidieux copier / coller surtout lorsque la recopie d'infos porte sur une telle quantités de cellules.

Mais je ne sais pas faire donc si tu réussis à obtenir UN RESULTAT, je suis preneur de ta macro.

Merci d'avance pour un "neo-excelien" !

Bonsoir moustic54
Je te rassure, je ne suis pas brillante non plus
Pour le moment aucun résultat (l'absence de connexion internet au boulot m'empeche de faire des recherches sur le net) donc j'essaye différentes choses sans vraiment savoir...
Alors comptez sur moi ???? Mon probleme reste entier.

 

[Julie-F]

Re : Macro et recopie de cellules

Je n'arrive à rien.
Quelqu'un aurait il la solution miracle ?

 

[bqtr]

Re : Macro et recopie de cellules

Bonjour Julie, Staple1600, moustic54

Voici une façon de faire :

Sub Recherche_Fichier()

Dim FS As FileSearch
Dim Rep As String
Dim i As Integer

Rep = "Q:\bilans" 'ici entre le chemin du répertoire de tes 8 fichiers
Set FS = Application.FileSearch
With FS
      .LookIn = Rep
      .Filename = "*.xls"
      .Execute
  If .FoundFiles.Count = 0 Then
       MsgBox "fichier non trouvé"
       Exit Sub
  End If
End With

For i = 1 To FS.FoundFiles.Count
 copie_Données (FS.FoundFiles(i))
Next i

End Sub


Sub copie_Données(Non_Fichier As String)

Dim derlign As Long
Dim j As Long

Application.ScreenUpdating = False
Workbooks.Open Filename:=Non_Fichier
derlign = Workbooks("test1").Sheets("souhaits").Range("A65536").End(xlUp).Row

For j = 1 To Worksheets.Count 'ici remplace 1 par 6

Application.DisplayStatusBar = True
Application.StatusBar = "Traitement du fichier: " & Non_Fichier & " feuille " & Worksheets(j).Name & " en cours..."

   With Worksheets(j)
        Workbooks("test1").Sheets("souhaits").Range("A" & derlign + 1) = Mid(Non_Fichier, 11)
        .Range("C10,C11,C40").Copy
        Workbooks("test1").Sheets("souhaits").Range("B" & derlign + 1 & ":D" & derlign + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
        .Range("D40").Copy
        Workbooks("test1").Sheets("souhaits").Range("E" & derlign + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
        .Range("C64,C65,C240").Copy
        Workbooks("test1").Sheets("souhaits").Range("F" & derlign + 1 & ":H" & derlign + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
        .Range("D240").Copy
        Workbooks("test1").Sheets("souhaits").Range("I" & derlign + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
        .Range("C241,C242").Copy
        Workbooks("test1").Sheets("souhaits").Range("J" & derlign + 1 & ":K" & derlign + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
        derlign = Workbooks("test1").Sheets("souhaits").Range("A65536").End(xlUp).Row
  End With
  
Next j
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.StatusBar = False
Application.ScreenUpdating = True

End Sub

Je me suis basé sur le fichier de ton 1er message.
J'ai mis en commentaire (en vert dans le code) ce que tu dois modifier.
Il est impératif que tes fichiers soient identiques, il faut que tes 80 feuilles aient un index (code name) de 6 à 80 (Feuil6......feuil80), le nom n'est pas important.
Je ne garantie pas la rapidité, car tu copies des cellules qui ne se suivent pas.
Tu peux suivre l'avancement de la macro dans la barre d'état en bas de ta feuille.

Bon test

A+

 

[Julie-F]

Re : Macro et recopie de cellules

Bonjour Julie, Staple1600, moustic54

Voici une façon de faire : ...................

Je me suis basé sur le fichier de ton 1er message.
J'ai mis en commentaire (en vert dans le code) ce que tu dois modifier.
Il est impératif que tes fichiers soient identiques, il faut que tes 80 feuilles aient un index (code name) de 6 à 80 (Feuil6......feuil80), le nom n'est pas important.
Je ne garantie pas la rapidité, car tu copies des cellules qui ne se suivent pas.
Tu peux suivre l'avancement de la macro dans la barre d'état en bas de ta feuille.

Bon test

A+

Bonsoir à tous,

Merci beaucoup bqtr, je vais essayer tout de suite.

Une petite precision toutefois, lorsque tu écris :"il faut que tes 80 feuilles aient un index (code name) de 6 à 80 (Feuil6......feuil80), le nom n'est pas important." Est ce que cela signifie que je dois modifier le code name dans la fenêtre propriété du module objet si je n'ai pas feuille6..... dans l'éditeur de macros ?

 

[Excel-lent]

Re : Macro et recopie de cellules

Slt Julie-F,

Si tu as juste nommé tes onglets normalement, il n'y a pas de soucis. La macro de bqtr traitent de la 6ème feuille (elle se moque éperdument du nom) jusqu'au dernier onglet.

Par contre si tu as déplacé tes onglets, inséré des onglets au début, ou au milieu, cela risque de ne pas fonctionner.

Pour t'en assurer :
-> mémorise le nom des 3 premiers onglets
-> va dans l'éditeur de macro
-> dans la fenêtre de gauche tu verras :
Feuilx (nom du premier onglet)
Feuily (nom du second onglet)

x, y sont des chiffres de 1 à ... (80 dans ton cas)

Regarde si x = 1, y = 2, ...

Si oui, tout est ok!

 

[bqtr]

Re : Macro et recopie de cellules

Re, Salut Excel-lent

Si comme le dit Excel-lent

Par contre si tu as déplacé tes onglets, inséré des onglets au début, ou au milieu, cela risque de ne pas fonctionner.

Cela ne fonctionnera pas, il faudra alors boucler sur les feuilles et exclure celles qui ne serviront pas.

Ex:

For Each ws In ThisWorkbook.Worksheets
If ws.name <> "NomdelaFeuille" and ws.name <> "...." .....then
..../.... code
end if
next

Je le répète mais pour que ce genre de chose fonctionne, il faut impérativement que les fichiers à traiter aient la même structure.

A+

 

[Julie-F]

Re : Macro et recopie de cellules

Merci beaucoup

Comme vous me l'avez tous conseillé :
- j'ai bien vérifié le code name des différents onglets dans l'éditeur de macros
- l'emplacement des données à récupérer est identique dans tous les classeurs (seule différence : certains classeurs comportent 80 onglets alors que d'autres en comprennent plus de 80)
- Le répertoire contenant les fichiers est C:\Test

Mais toujours un pb :

Lorsque je mets une nouvelle feuille dans le fichier pour récupérer les infos j'ai un message d'erreur : Mémoire insuffisante.
Les fichiers sont lourds (+ de 38 Mo)

Lorsque j'essaye de récupérer les infos dans un nouveau classeur lors de l'exécution de la macro : Erreur de compilation Instruction incorrecte à l'extérieur d'une procédure

Que faire pour que cela fonctionne ?

J'avais essayé la macro du fichier Lecture (fichier fourni par kiki29 https://www.excel-downloads.com/threads/recherche-dans-plusieurs-fichiers.72998/) qui pourtant fonctionnait à merveille tout du moins dans la recuperation des Informations liées aux différents fichiers mais toujours rien pour les valeurs.

 

[bqtr]

Re : Macro et recopie de cellules

Bonsoir Julie,

La macro fonctionne correctement chez moi (testé avec 5 fichiers de 4 feuilles dans un même répertoire).

Pour le problème de la nouvelle feuille, tu peux remplacer dans le code :
Sheets("souhaits") par Activsheet.
Comme cela tu peux lancer la macro à partir de n'importe quelle feuille de ton classeur récap.
Pour alléger la taille du fichiers de récap, tu peux aussi copier uniquement les valeurs des cellules (pas le format comme les couleurs de fond par exemple)
Dans ce cas remplace XlPasteAll par XlPastesValues.

Maintenant 38 Mo, je ne pense pas qu'Excel soit conçu pour gérer facilement des fichiers de cette taille. Et là y a pas grand chose à faire, soit revoir ta façon de faire comme utiliser 2 ou 3 fichiers de récap ou alors d'utiliser ACCESS qui lui est fait pour gérer des grosses bases de données ou encore d'augmenter la puissance de ton ordi.

Pour ton problème de nouveau classeur, je vois pas trop, as tu pensé à mettre le nouveau nom de ce dernier dans la macro en remplacement de l'ancien (test1 dans le code) ?

Bonne fin de soirée

 

[Julie-F]

Re : Macro et recopie de cellules

Bonjour Bqtr,

Je sais que tu as raison lorsque tu preconises l'utilisation d'Access, malheureusement je n'ai ni le choix des logiciels ni la conception des fichiers Excell (trop de mise en forme inutile)
Je dois simplement travailler sur les fichiers Excell deja existants et vraiment tres lourds ce qui me pose des soucis quotidiennement lorsqu'il s'agit de recuperer un certain nb de données de ces fichiers.

C'est pour cette raison que je souhaitais avoir une macro qui me permette de recuperer ces infos dans un nouveau classeur vierge sans ouvrir tous ces gros fichiers (qui de par leur lourdeur ne peuvent être ouverts qu'un par un sinon memoire insuffisante)
Macro que j'aurai pu modifier en fonction des valeurs recherchées ou des fichiers analysés.

Sinon nouveau message d'erreur lors de l'execution de la macro : derlign = Workbooks("test1").Activsheet.Range("A65536").End(xlUp).Row