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 pc1
télephone5
etc9
etc13
etc17
etc2019
etc10
Prix8
Configuration17

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 ;)

6donnees-1.xlsx (12.92 Ko)
4donnees-2.xlsx (11.62 Ko)

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

Rechercher des sujets similaires à "selectionner plage find"