Sélectionner une plage avec cell.find et cell.find -1
Bonjour le forum,
J'ai créer un code VBA qui est bientôt terminer mais j'ai rencontrer un problème. J'ai créer un fichier qui permet d'extraire des données de plusieurs fichiers .xls, jusqu'ici le code fonctionne parfaitement mais les cellules ne sont toujours pas au même emplacement, j'ai donc utilisé la fonction cell.find...
Pour la faire plus simple pour vous, voici un tableau d'exemple ci-dessous.
Nombre de pc | 1 |
télephone | 5 |
etc | 9 |
etc | 13 |
etc | 17 |
etc | 2019 |
etc | 10 |
Prix | 8 |
Configuration | 17 |
Je souhaite que ma macro sélectionne la cellule "nombre de pc" jusqu'à la cellule "Configuration - 1", soit la cellule "Prix"
J'ai réussi à faire 90 % du code mais je reste bloquer sur ça, s'il vous plait épargner moi de cell.find.("prix"), parfois ce n'est pas le mot "prix" dans les différents fichiers. Je veux qu'il localise nombre de pc (qui est déja fait) et puis il localise "configuration" puis il prend la cellule au dessus
Je vous ai mit l'emplacement probable du code, j'ai déja mit le set s = cell.find("configuration").
Sub ImportdonnéesinformatiqueLDA()
Const str_nameshedit As String = "Informatique" 'Onglet où sont situé les informations à extraire
Const str_namesident As String = "Identification" 'Onglet où sont situé les informations à extraire
Dim wkb_source As Workbook
Dim wsh_result As Worksheet
Dim Chemin As String, Fichier As String
Dim i As Long
Dim R As Range
Dim OS As Worksheet '<---------- ICI
'Affectation de la cellule répertoire
Set wsh_result = ActiveSheet
Chemin = [B1]
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
Fichier = Dir(Chemin & "*.xls*") 'Chemin d'accès
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.AskToUpdateLinks = False
i = 5 'Début = ligne 5
Do While Len(Fichier) > 0
'1ère étape nb pc
Set wkb_source = Workbooks.Open(Chemin & Fichier)
Application.DisplayAlerts = False
wsh_result.Cells(i, 1) = wkb_source.Sheets(str_namesident).[J18] 'numéro du fichier xl
'***
'ici je déclare que si la feuille informatique n'existe pas alors on ferme passe au fichier suivant !
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set OS = Worksheets("Informatique") 'définit l'onglet source OS (génère une erreur si cet onglet n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
Err.Clear 'supprime l'erreur
wsh_result.Cells(i, 2) = "pas de feuille infomatique"
GoTo suite 'va à l'étiquette "suite (fermer le fichier et loop)
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
'***
Set R = Sheets("Informatique").Cells.Find(What:="Nombre de PC", After:=ActiveCell, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Set s = Sheets("Informatique").Cells.Find(What:="Configuration", After:=ActiveCell, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not R Is Nothing Then
Range(R, s.End(xlToRight)).Copy <---- C'est environ ici que le code doit être modifié !!!!
Windows("Informatique ligneànepassupprimer- Copie.xlsm").Activate
Cells(i, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End If
Set R = Nothing ' si il ne trouve pas le mot rechercher alors on va à l'étape suivante
Set s = Nothing
'On passe à la ligne suivante pour le prochain fichier
i = i + 1 'Nombre de pc + ligne actuelle
suite: '<---------- ICI
wkb_source.Close
Fichier = Dir()
Loop
Set wkb_source = Nothing
Set wsh_result = Nothing
MsgBox "Terminé"
End Sub
Re,
Essaie comme ça en remplaçant :
If Not R Is Nothing Then
Range(R, s.End(xlToRight)).Copy
par :
If Not R Is Nothing And Not s Is Nothing Then
Range(R, s.Offset(0, -1).End(xlToRight)).Copy
Salut !
Ta macro fonctionne, mais elle ne me copie seulement la colonne A, elle ne me prend pas les valeurs de la colonne B.
Pour le Range(R, s.Offset(0, -1) c'est OK, mais je pense que c'est le .End(xlToRight)).Copy qui ne veut pas fonctionner, tu as une solution ?
Re,
Oui certainement... Quand tu daigneras fournir un fichier exemple....
Re,
Voici les fichiers, c'est assez complexe car il y a énormément de condition, tu as la macro dans résultat-voulu. (Désoler je suis vraiment nul et je débute en VBA).
Le but c'est de prendre les données situé dans un répertoire, puis de les importer dans résultat voulu à l'aide d'une macro. Tu doit donc dans la cellule B2 renseigné ton répertoire !
La macro est à modifier à partir de la deuxième étapes ! Tout ce qui est avant est correct (sauf si tu pense qu'il faut déclarer qqch)..
Ensuite les données ne doivent pas être à la suite, je m'explique : exemple la Colonne N représente le Prix, la colonne W représente l'année. Je veut tout aligné.
Enfin je souhaite additionner mon numéro de ligne avec le nombre de PC juste avant de faire le LOOP à la fin, qui permettra de changer le numéro de ligne au fichier suivant. C'est un bonus si tu veut le pas le faire il n'y a a pas de soucis tu m'a déjà fait assez ;)
Ah et j'oublie l'essentiel il faut prendre la plage de configuration a PRIX-1 et .end(xltoright)
Pareil pour le prix , plage prix à année-1 .end(xltoright)
PS : J'ai 1068 fichier données
Bonjour le forum,
Je réitère ma demande, svp je reste toujours bloqué sur ce sujet.
Merci d'avance