Extraire données d'une feuille vers une BDD via VBA

Bonjour à tous,

J'ai travaillé un peu sous VBA il y a un moment déjà, et là j'aimerai m'y remettre pour un sujet au travail, seulement je ne sais pas trop par quel bout commencer! Alors je viens à la pêche aux idées!

Je possède une banque de données où chaque feuille excel correspond à un sondage (géologique) et j'aimerai extraire ces données afin de créer une base de données.

Sur la fiche de sondage, une cellule correspond au nom du sondage et ensuite chaque ligne correspond à un échantillon. Dans la base de données il me faudrait donc une ligne par échantillon.

Je vous mets un exemple ci-dessous où 31 32 33 sont des sondages et "geology" la base de données où j'aimerai extraire les données.

J'espère que c'est assez clair

Si quelqu'un à une idée de comment il ferait, ça m'intéresse beaucoup car n'en ayant pas fait depuis un moment je bloque un peu!

Merci d'avance pour votre aide!

Elise

Bonjour

ne sachant pas ce que tu souhaites vraiment extraire ci joint ton fichier qui fait une feuille resultat en faisant l'extraction de la date, lieu, n° de sondage

a toi de compléter ce que tu souhaite centraliser dans ta feuille resultat

fred

Sub recup()
Dim i As Integer
Dim lg As Integer
Dim sh As Worksheet

Set sh = Sheets("resultat")
'effacement des donnés présentes dans la feuille resultat
If [A65536].End(xlUp).Row > 1 Then sh.Range("A2:C" & sh.[A65536].End(xlUp).Row).ClearContents
'initailisa compteur ligne
lg = 2

For i = 1 To Sheets.Count - 1
    If IsNumeric(Sheets(i).Name) Then
       sh.Cells(lg, "A") = Sheets(i).[L2].Value
       sh.Cells(lg, "B") = Sheets(i).[E5].Value
       sh.Cells(lg, "C") = Sheets(i).[E6].Value
'a completer............
       lg = lg + 1

    End If
Next i
End Sub

Bonjour et bienvenue,

Il n'y a pas de feuille 'Geology'.

On ne sait donc pas quelles sont les données à consolider.

Cdlt.

Re Bonjour!

Bon déjà désolée c'est pas le bon fichier que j'ai téléchargé...

Voilà le bon fichier!

Merci beaucoup Fred pour votre réponse rapide! Du coup, si je veux extraire plusieurs lignes par feuilles, je dois faire une boucle if dans la première c'est ça?

En effet je n'ai pas trop précisé dans le premier commentaire, dans les feuillets '33 '32' '31', je veux extraire le nom du sondage mais aussi toutes les lignes à partir de la 25 pour créer dans le feuillet 'geology' une ligne à chaque fois (une ligne par échantillon). Sur chaque ligne j'aurai le nom du sondage, puis toutes les colonnes visibles sur les lignes 23-24 du feuillet '33'

Par exemple pour le feuillet '33' j'aurai 4 lignes au total, 5 pour le '32' et 4 pour le '31'.

Merci pour ce premier élément de réponse en tous cas, je vais tenter de le développer avec mes souvenirs!

Bien cordialement,

Elise

Re bonjour

il aurait été préférable d'avoir le bon fichier dès le départ....

ci joint donc une macro, problème ne je sais pas comment est rempli ta colonne description...

fred

Sub recup()
Dim i As Integer
Dim lg As Integer
Dim nblg
Dim sh As Worksheet

Set sh = Sheets("geology")
For i = 3 To Sheets.Count
    If IsNumeric(Sheets(i).Name) Then
        lg = sh.[A65536].End(xlUp).Row + 1
        nblg = Sheets(i).[C65536].End(xlUp).Row - 24
        sh.Cells(lg, "B").Resize(nblg, 2) = Sheets(i).[B25].Resize(nblg, 2).Value
        'colonne description ??? par quoi cela est rempli ???
        sh.Cells(lg, "E").Resize(nblg, 6) = Sheets(i).[G25].Resize(nblg, 6).Value
        sh.Cells(lg, "A").Resize(nblg, 1) = Sheets(i).[E5].Value
    End If
Next i
End Sub

Merci beaucoup!

Pour la colonne description, elle concerne uniquement mes anciennes données donc pas de problèmes elle n'est pas à extraire.

Une dernière question, si je veux ajouter la date dans la dernière colonne, mais extraire seulement l'année, comment je dois placer la fonction Year?

(la ligne ci-dessous me met 1899 partout...)

sh.Cells(lg, "Q").Resize(nblg, 1) = Year(L2)

Elise

re bonjour

essai en mettant plutot ceci :

 sh.Cells(lg, "Q").Resize(nblg, 1) = Year(Sheets(i).[L2])

fred

Génial!

Un grand merci pour votre aide et votre rapidité!