Bonjour,
Voici la macro que j'utilise pour extraire des colonnes d'une feuille, et vous trouverez ci-joint le classeur qui va avec (extraction données) :
Néanmoins je souhaiterais dupliquer cette macro pour obtenir un 2e bouton dans la même feuille, que les données soient en colonne M par exemple et que l'extraction se fasse en colonnes P:S.
Pour dupliquer le bouton et afficher le nom du fichier il n'y a pas de problèmes, en revanche pour extraire les colonnes il y a toujours des erreurs (dues aux "dim" qui sont identiques je pense).
Vous pourrez trouver la forme que je cherche dans "modèle extraction"
Merci d'avance pour votre aide,
Etn.
Voici la macro que j'utilise pour extraire des colonnes d'une feuille, et vous trouverez ci-joint le classeur qui va avec (extraction données) :
VB:
Private Sub CommandButton21_Click()
Dim fich
[G4:G5] = "":
fich = Application.GetOpenFilename
If fich = False Then Exit Sub
[G4] = Left(fich, InStrRev(fich, "\"))
[G5] = Mid(fich, InStrRev(fich, "\") + 1)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G4:G7]) Is Nothing Or Application.CountBlank([G4:G7]) Then Exit Sub
Dim dossier$, fich$, ext$, feuil$, zone$, r As Range, f$, col%, ad$, h&, h1&
dossier = [G4]
fich = [G5]
ext = Mid(fich, InStrRev(fich, "."))
feuil = [G6]
zone = [G7]
[A:D].ClearContents 'RAZ
If fich = ThisWorkbook.Name Then [G5] = "": Exit Sub
If Dir(dossier & fich) = "" Then MsgBox "Fichier introuvable...": Exit Sub
If Not ext Like ".xls*" Then MsgBox "Ce n'est pas un fichier Excel...": Exit Sub
On Error Resume Next
Set r = Range(Replace(zone, ";", ",")).EntireColumn
If r Is Nothing Then MsgBox "Revoir l'adressage des colonnes...": Exit Sub
Set r = Intersect(r, Rows(1))
If r.Count > 4 Then MsgBox "Maximum 4 colonnes...": Exit Sub
Application.ScreenUpdating = False
f = "'" & dossier & "[" & fich & "]" & feuil & "'!"
For Each r In r
col = col + 1
ad = r.EntireColumn.Address(ReferenceStyle:=xlR1C1)
h = 0: h1 = 0
h = ExecuteExcel4Macro("MATCH(9^9," & f & ad & ")")
h1 = ExecuteExcel4Macro("MATCH(""zzz""," & f & ad & ")")
h = Application.Min(IIf(h > h1, h, h1), Rows.Count)
If h Then
ad = r.Resize(h).Address(ReferenceStyle:=xlR1C1)
With Cells(1, col).Resize(h)
.FormulaArray = "=" & f & ad 'formule matricielle
.Value = .Value 'supprime la formule
End With
End If
Next
End Sub
Néanmoins je souhaiterais dupliquer cette macro pour obtenir un 2e bouton dans la même feuille, que les données soient en colonne M par exemple et que l'extraction se fasse en colonnes P:S.
Pour dupliquer le bouton et afficher le nom du fichier il n'y a pas de problèmes, en revanche pour extraire les colonnes il y a toujours des erreurs (dues aux "dim" qui sont identiques je pense).
Vous pourrez trouver la forme que je cherche dans "modèle extraction"
Merci d'avance pour votre aide,
Etn.