macro pour transfert de données

Version imprimable

04/11/2009, 12h24
arctica

1 pièce(s) jointe(s)

macro pour transfert de données

Bonjour à tous,
Je souhaiterai une aide car si je me suis mis au Vba je suis encore trop novice pour établir des macros seul. Je voudrais automatiser le transfert du stock journalier de la colonne B de la feuil1 vers le stock mensuel de la feuil2(dans le reel il s'agit de 2 classeur différents mais pour l'exemple je les ai assemblée dans un classeur) en sachant que la date de la feuille 1 est aujourdhui(). cette date sera recherchée en colonne A de la feuille 2.Les criteres du stock sont en colonne a5:a9 pour la feuille 1, criteres que je retrouve dans les colonnes B:E dans la feuille 2
Je joins évidemment le fichier
Merci pour votre aide

Je me suis permis d'ouvrir ton fichier, alors qu'il serait mieux d'expliciter ce que tu as fais! poster un fichier et attendre des réponses...
Pour cette fois, ci-dessous une proposition

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim plage As Range, c As Range
Dim LastLig As Long
Dim i As Byte
 
LastLig = Sheets("Feuil2").Range("A65536").End(xlUp).Row
Set plage = Sheets("Feuil2").Range("A7:A" & LastLig)
Set c = plage.Find(Sheets("Feuil1").Range("A1").Value, LookIn:=xlFormulas, lookat:=xlWhole)
If Not c Is Nothing Then
    For i = 1 To 5
        c.Offset(0, i).Value = Sheets("Feuil1").Range("B" & i + 4).Value
    Next i
End If
Set c = Nothing
Set plage = Nothing

Bonjour,

Essaie avec ce code à placer dans le classeur où se trouve les données à reporter (celles en jaune dans la feuille 1).

A noter que :
- Dans le classeur contenant les données en couleur jaune, la feuille est nommée FEUIL1
- Dans le classeur contenant le tableau à compléter, la feuille recevant les données est nommée FEUIL2

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub test()
'Macro Dan pour arctica le 04/11/09 sur excel developpez
Dim lig As Byte
Dim wbk1 As Workbook, wbk2 As Workbook
Set wbk1 = ThisWorkbook
Set wbk2 = Workbooks("Tata.xls")
On Error GoTo Fin
lig = WorksheetFunction.Match(wbk1.Sheets("Feuil1").Range("A1"), _
        wbk2.Sheets("Feuil2").Range("A7:A37"), 0) + 6
With wbk2.Sheets("Feuil2")
    .Range("B" & lig) = wbk1.Sheets("Feuil1").Range("B5")
    .Range("C" & lig) = wbk1.Sheets("Feuil1").Range("B6")
    .Range("D" & lig) = wbk1.Sheets("Feuil1").Range("B7")
    .Range("E" & lig) = wbk1.Sheets("Feuil1").Range("B8")
    .Range("F" & lig) = wbk1.Sheets("Feuil1").Range("B9")
End With
Exit Sub
Fin:
MsgBox "La date en cellule " & wbk1.Sheets("Feuil1").Range("A1") & vbCrLf & _
    "n'existe pas dans le fichier " & wbk2.Name
End Sub

Amicalement

Dan ;)

04/11/2009, 15h34
arctica

bonjour Mercatog,bonjour Nad-Dan

Je sors d'une reunion je n'ai donc pu répondre plus vite .Je vais donc tester vos macros que vous m'avez écrites en les étudiant pour apprendre. A l'heure actuelle quand j'ecris des macros et que cela ne marche pas je ne les mets pas systematiquement en page car quand je les compare aux votres je m'apercois que c'est parfois du charabia en tous les cas merci pour votre aide
04/11/2009, 15h41
mercatog

Citation:

quand j'ecris des macros et que cela ne marche pas je ne les mets pas systematiquement en page

Mon avis personnel, mauvaise décision, de ses propres fautes on apprends mieux.

utilisation macro avec 2 classeurs

Bonjours à tous

J'ai un souci avec la macro de Mercatog, (merci à lui) qui fonctionne tres bien avec le fichier fourni . Mon problème est que j'essaye de la faire fonctionner entre 2 classeurs La feuille 1 = (Wbstock_journalier.Worksheets("Tagesbestand").et la feuille 2 =(WbBestand_2009.WorkSheets("novembre" )classeur2 Dans le developpement je n'ai pas d'erreur mais au final le transfert des données ne se fait pas Voici la macro originale

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub stic()
 
Dim plage As Range, c As Range
Dim LastLig As Long
Dim i As Byte
 
LastLig = Sheets("Feuil2").Range("A65536").End(xlUp).Row
Set plage = Sheets("Feuil2").Range("A7:A" & LastLig)
Set c = plage.Find(Sheets("Feuil1").Range("A1").Value, LookIn:=xlFormulas, lookat:=xlWhole)
If Not c Is Nothing Then
    For i = 1 To 5
        c.Offset(0, i).Value = Sheets("Feuil1").Range("B" & i + 4).Value
    Next i
End If
Set c = Nothing
Set plage = Nothing
End Sub

et voici celle que j'essaye d'utiliser

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub stockage()
 
Dim Wbstock_journalier As Workbook, WbBestand_2009 As Workbook
Dim plage As Range, c As Range
Dim LastLig As Long
Dim i As Byte
Workbooks.Open "C:\Documents and Settings\PC42\Bureau\suivi stock\stock_journalier.xls"
Set Wbstock_journalier = ActiveWorkbook
ActiveWorkbook.RefreshAll
Workbooks.Open "T:\suivi_stock_2009\Bestand_2009.xls"
Set WbBestand_2009 = ActiveWorkbook
'With WbBestand_2009.Worksheets("novembre")
LastLig = Sheets("novembre").Range("A65536").End(xlUp).Row
Set plage = Sheets("novembre").Range("A7:A" & LastLig)
'With Wbstock_journalier.Worksheets("Tagesbestand")
Set c = plage.Find(Wbstock_journalier.Worksheets("Tagesbestand").Range("A1").Value, LookIn:=xlFormulas, lookat:=xlWhole)
If Not c Is Nothing Then
    For i = 1 To 5
        c.Offset(0, i).Value = Wbstock_journalier.Worksheets("Tagesbestand").Range("B" & i + 4).Value
    Next i
End If
Set c = Nothing
Set plage = Nothing
'End With
'end With
End Sub

je ne vois pas ou est l'erreur
Pourriez vous m'aider? le classeur est le classeur 1 joins