VBA copier coller entre plusieurs fichiers différents

[cg1980]

Bonjour,

J'aimerais faire qqchose de peut-être un peu particulier.

Il s'agirait de travailler comme dans une base de données entre 2 fichiers excel.

Dans le fichier extraction.xls, j'aimerais faire des extractions venant du fichier base.

Dans base, en mettant la date d'extraction en C2, j'aimerais lancer une macro qui me fasse un copier coller en transopsé de la ligne 1 (les codes ISIN) et également me copie le montant qu'on a dans ces codes à la date indiqué d'extraction.

en changeant la date on change les montants mais on copie toujours les codes au cas où il y a eu des nouveaux ajouts.

merci de votre aide. j'espere etre assez clair. dites moi si besoin de plus de précision

 

[job75]

Re : VBA copier coller entre plusieurs fichiers différents

Bonjour cg1980,

C'est vraiment très classique.

Dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, [C2])
If Target Is Nothing Then Exit Sub
Application.ScreenUpdating = False
[B4:B6] = ""
If Target = "" Then Exit Sub
Dim Wb As Workbook, F As Worksheet, lig As Variant
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
On Error Resume Next
Set Wb = Workbooks.Open(ThisWorkbook.Path & "\base") 'chemin à adapter
If Err Then MsgBox "Fichier 'base' introuvable...": Exit Sub
Set F = Wb.Sheets("Feuil1") 'nom de feuille à adapter
If Err Then MsgBox "Feuille 'Feuil1' introuvable...": Exit Sub
On Error GoTo 0
lig = Application.Match(Target, F.[A:A], 0)
If IsNumeric(lig) Then _
  [B4:B6] = Application.Transpose(F.Cells(lig, 2).Resize(, 3))
Wb.Close 'fermeture du fichier base
End Sub

Notez le contrôle d'erreur.

Fichiers .xls joints. Les télécharger sur le bureau avant de tester.

A+

 

[cg1980]

Re : VBA copier coller entre plusieurs fichiers différents

c'est pas mal du tout et c'est très propre.merci

 

[cg1980]

Re : VBA copier coller entre plusieurs fichiers différents

re bonjour.

c-est pas mal pousse pour moi je dois dire et je ne connais pas exactement le fonctionnement de cette facon de faire.

quelqu un peut m aider a adapter cela dans le fichier ci joint.

au lieu d avoir 2 file, il n y en a que un.


message readapter ci dessous
"Bonjour,

J'aimerais faire qqchose de peut-être un peu particulier.

Il s'agirait de travailler comme dans une base de données entre 2 feuilles.

Dans le fichier testi.xls, j'aimerais faire des extractions venant de la page historical market values.

Dans feuil1, en mettant la date d'extraction en C2, j'aimerais lancer une macro qui me copie le montant qu'on a dans ces codes à la date indiqué d'extraction.

en changeant la date on change les montants indiques
merci de votre aide. j'espere etre assez clair. dites moi si besoin de plus de précision .

 

[job75]

Re : VBA copier coller entre plusieurs fichiers différents

Bonsoir,

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, [C2])
If Target Is Nothing Then Exit Sub
Dim lig As Variant
With Sheets("Historical Market Values") 'With Sheet4 'CodeName
  lig = Application.Match(Target, .[A:A], 0)
  If IsError(lig) Then
    [B5:B8] = ""
  Else
    [B5:B8] = Application.Transpose(.Cells(lig, 2).Resize(, 4))
  End If
End With
End Sub

A+

 

[cg1980]

Re : VBA copier coller entre plusieurs fichiers différents

merci mais ou est ce que je dois preciser si par exemple ma liste de code s allonge. je ne vais donc plus jusqua A8 mais jusqu a A100 par exemple. c est a dire que la liste de en colA Feuil1 ne va plus jusqu en A8 mais jusqu a A100

merci encore

 

[job75]

Re : VBA copier coller entre plusieurs fichiers différents

Re,

Quel que soit le nombre de colonnes à transposer :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, [C2])
If Target Is Nothing Then Exit Sub
Dim lig As Variant, col As Integer
With Sheets("Historical Market Values") 'With Sheet4 'CodeName
  lig = Application.Match(Target, .[A:A], 0)
  col = .Cells(1, .Columns.count).End(xlToLeft).Column 'dernière colonne
  [A4].Resize(col) = Application.Transpose(.[A1].Resize(, col))
  If IsError(lig) Then
    Range("A4:B" & Rows.count) = ""
  Else
    [B5].Resize(col - 1) = Application.Transpose(.Cells(lig, 2).Resize(, col - 1))
  End If
End With
End Sub

Fichier (2).

A+

 

[job75]

Re : VBA copier coller entre plusieurs fichiers différents

Bonjour cg1980, le forum,

J'ai revu l'effacement des plages en fin de macro :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, [C2])
If Target Is Nothing Then Exit Sub
Dim lig As Variant, col As Integer
With Sheets("Historical Market Values") 'With Sheet4 'CodeName
  lig = Application.Match(Target, .[A:A], 0)
  col = .Cells(1, .Columns.count).End(xlToLeft).Column 'dernière colonne
  [A4].Resize(col) = Application.Transpose(.[A1].Resize(, col))
  If IsNumeric(lig) Then _
    [B5].Resize(col) = Application.Transpose(.Cells(lig, 2).Resize(, col))
  [A4:B4].Offset(IIf(IsNumeric(lig), col, 0)).Resize(20000).ClearContents
End With
End Sub

Fichier (3).

A+