Extraire les donnees d un fichier vers un autre
Bonjour le Forum,
je sollicite une fois de plus votre aide. je travaille avec deux fichiers excel (Mappe1 et Mappe2). je veux copier les informations de la Mappe1 dans la Mappe2 tout en changeant quelques points.
- Dans la colonne A il s y trouve plusieurs ID et ces ID ont parfois le meme numero.je veux que lorsque les numeros sont identique seul ceux qui ont le plus grand Assesment doivent soient copie dans la Mappe2
- Dans la colonne B tous les projets avec le Nom "PFM" doivent prendre le nom MSS2 dans une nouvelle colonne (Bereich de la mappe2).
Desole pour les accents je n ai pas un clavier francais.
les deux fichiers ci joint
Salut Aimee Daline,
pour comprendre ceci, (moi en tout cas),
je veux que lorsque les numeros sont identique seul ceux qui ont le plus grand Assesment doivent soient copie dans la Mappe2
il faudrait plus de lignes de ton fichier et des explications plus claires!
Assesment ???
A+
Bonjour le Forum,
Desole je voulais dire seul ceux qui ont le plus grand Q-level doivent etre copier dans la Mappe2 lorsque les numeros sont identique
bonjour le Forum ,
voici c est ceque j ai programme jusqu ici mais ca ne fonctionne pas pouvez vous me dire ou il ya erreur? Merci bien
Sub Makro1()
Dim Weg As String, Datei As String, Datei2 As String
Dim wkb As Workbook
Dim shfrom As Worksheet
Dim shTo As Worksheet
Dim varTab As Variant
Dim MSS, PFM As String
Dim PlgA As Range
Dim plgD As Range
Dim CelA As Range
Dim lnglast As Long
Dim maxvalRange As Range
Dim nbligne, str2, strX As String
Dim k As Integer
'Dim result
Dim Ligne, ligne2 As Integer
Dim ligneFin As String
Dim ID, Lev As String
Dim result(1 To 100, 1 To 3)
'Weg = ThisWorkbook.Path & "\" & "Mappe2.xlsx"
'Workbooks.Open Weg
'[A3].Resize(ligne2, 3) = result
'ActiveWorkbook.Save
'ActiveWorkbook.Close
'Weg = ThisWorkbook.Path & Application.PathSeparator
'Datei = "Mappe1.xlsx"
' pointeurs
'Set wkb = Workbooks.Open(Weg & Datei)
'Set shfrom = wkb.Worksheets("Tabelle1")
'Set shTo = ThisWorkbook.Worksheets("Tabelle2")
'With Worksheets("Tabelle1")
' Set PlgA = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
' Set plgD = .Range(.Cells(2, 4), .Cells(.Rows.Count, 4).End(xlUp))
' Application.ScreenUpdating = False
' ActiveWorkbook.Close
'For Each CelA In PlgA
'maxi = WorksheetFunction.Max(Range("C3:C500"))
'shTo.Colummns(1).Clear
' Dim result(1 To 100, 1 To 3)
Sheets("Tabelle1").[A2].Sort key1:=Sheets("Tabelle1").[A3], Order1:=xlAscending, _
key2:=Sheets("Tabelle1").[C3], Order2:=xlDescending, Header:=xlYes
Ligne = 3
ligneFin = [A65000].End(xlUp).Row
ligne2 = 3
Do While Ligne < ligneFin
ID = Cells(ligne2, 1): Lev = Cells(ligne2, 3)
Do While Cells(Ligne, 1) = ID
Do While Cells(Ligne, 3) >= Lev
'For k = 1 To 3: result(ligne2, k) = Cells(Ligne, k): Next k
ligne2 = ligne2 + 1
Ligne = Ligne + 1
Loop
Ligne = Ligne + 1
Loop
Loop
Weg = ThisWorkbook.Path & "\" & "Mappe2.xlsx"
Workbooks.Open Weg
Sheets("Tabelle1").Activate
[A].Resize(ligne2, 3).Copy , Destination:=Weg
'result.Copy
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub