KisskooOool
XLDnaute Nouveau
Bonjour,
Je suis totalement débutant en macro sur excel.
Je connais un peu excel et ses formule, mais les macros, rien du tout.
Je sollicite donc votre aide :
J'ai "fait" un code, ou plutot recopier des codes de diverses sources internet pour arriver à mes fins.
J'ai donc réussi à obtenir ce code que je comprend à peu près puisque je l'ai modifier.
Le voici :
Option Explicit
Const Vcol As Long = 5
Sub Itemscommuns() 'FLA 24.03.08
' COMPARER 1 COLONNE DANS 2 FEUILLES, FLAGER
' LES ITEMS COMMUNS AUX 2 COLONNES
' INSCRIRE LES LIGNES CORRESPONDANTES DANS UNE FEUILLE
' CRITÈRE DE COMPARAISON :ITEMS EN COLONNE A; À DÉFINIR
Dim Tablo As Variant, Tabb As Variant, Tabc As Variant
Dim Sbd1 As Worksheet, Sbd2 As Worksheet
Dim I&, J&, Ka&, Kb&, Kc&, Cola&, Colb&
Dim Fichier1$, cell1 As Range
Dim Fichier2$, cell2 As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set Sbd1 = Feuil2
Set Sbd2 = Feuil3
Ka = Feuil2.Cells(65536, 1).End(xlUp).Row
Kb = Feuil3.Cells(65536, 1).End(xlUp).Row
Cola = 1
Colb = 1
' RAZ TRAITEMENT PRECEDENT
Feuil7.Range("A1").Offset(1, 0).Resize(Ka + Kb, Vcol).ClearContents
' CHARGEMENT DANS TABLEAUX DES DATAS À COMPARER
Tablo = Feuil2.Cells(2, 1).Resize(Ka, Cola).Value
Tabb = Feuil3.Cells(2, 1).Resize(Kb, Colb).Value
ReDim Tabc(1 To UBound(Tablo), 1)
' COMPARAISON DES DATAS CHARGEES DANS LES TABLEAUX
For I = LBound(Tablo) To UBound(Tablo)
For J = LBound(Tabb) To UBound(Tabb)
If Tablo(I, 1) = Tabb(J, 1) Then
Tabc(I, 1) = Tablo(I, 1)
End If
Next J
Next I
Kc = 1
' RESTITUTION DES ITEMS COMMUNS EN FEUIL7
Feuil7.Cells(1, 1) = Feuil2.Cells(1, 1)
For I = LBound(Tabc) To UBound(Tabc)
If Tabc(I, 1) <> vbNullString Then
Feuil7.Cells(Kc + 1, Cola) = Tabc(I, 1)
Kc = Kc + 1
End If
Next
Set Sbd1 = Nothing: Set Sbd2 = Nothing
Erase Tablo: Erase Tabb
' COPIE DES ITEMS COMMUNS DANS FEUIL7
Call Transfertcommuns
Erase Tabc
Application.GoTo reference:=Feuil7.Cells(2, 1), Scroll:=True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Public Sub Transfertcommuns()
' COPIE DES PLAGES DES ITEMS COMMUNS DANS FEUIL7
' COPIE DES DATAS DE LA FEUILLE BASE1
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Tabuniq As Variant, Vardatas As Variant
Dim K&, Kf&, Col&
Col = 1
K = Feuil2.Cells(65536, Col).End(xlUp).Row
Kf = Feuil7.Cells(65536, Col).End(xlUp).Row
Tabuniq = Feuil7.Cells(1, Col).Resize(K, Col).Value
Vardatas = Feuil2.Cells(1, Col).Resize(K, Vcol).Value
For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil7.Cells(Kf, 2) = Vardatas(K, 2)
Feuil7.Cells(Kf, 3) = Vardatas(K, 3)
Feuil7.Cells(Kf, 4) = Vardatas(K, 4)
Feuil7.Cells(Kf, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Application.Calculation = xlCalculationAutomatic
Erase Vardatas: Erase Tabuniq
End Sub
Ce code me permet de comparer les feuilles 2 et 3 de mon classeur et de copier les lignes en communs dans la feuille 7
Le probleme est qu'il travail sur les feuilles du claseur en cours, et mon but est de faire ceci sur des feuille situées dans d'autres fichier, sans les ouvrir si possible.
j'ai vu que c'était possible grace à la commande "Workbooks.Open", mais je n'arrive pas à m'en servir par inexpérience.
Merci de votre aide.
Je suis totalement débutant en macro sur excel.
Je connais un peu excel et ses formule, mais les macros, rien du tout.
Je sollicite donc votre aide :
J'ai "fait" un code, ou plutot recopier des codes de diverses sources internet pour arriver à mes fins.
J'ai donc réussi à obtenir ce code que je comprend à peu près puisque je l'ai modifier.
Le voici :
Option Explicit
Const Vcol As Long = 5
Sub Itemscommuns() 'FLA 24.03.08
' COMPARER 1 COLONNE DANS 2 FEUILLES, FLAGER
' LES ITEMS COMMUNS AUX 2 COLONNES
' INSCRIRE LES LIGNES CORRESPONDANTES DANS UNE FEUILLE
' CRITÈRE DE COMPARAISON :ITEMS EN COLONNE A; À DÉFINIR
Dim Tablo As Variant, Tabb As Variant, Tabc As Variant
Dim Sbd1 As Worksheet, Sbd2 As Worksheet
Dim I&, J&, Ka&, Kb&, Kc&, Cola&, Colb&
Dim Fichier1$, cell1 As Range
Dim Fichier2$, cell2 As Range
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set Sbd1 = Feuil2
Set Sbd2 = Feuil3
Ka = Feuil2.Cells(65536, 1).End(xlUp).Row
Kb = Feuil3.Cells(65536, 1).End(xlUp).Row
Cola = 1
Colb = 1
' RAZ TRAITEMENT PRECEDENT
Feuil7.Range("A1").Offset(1, 0).Resize(Ka + Kb, Vcol).ClearContents
' CHARGEMENT DANS TABLEAUX DES DATAS À COMPARER
Tablo = Feuil2.Cells(2, 1).Resize(Ka, Cola).Value
Tabb = Feuil3.Cells(2, 1).Resize(Kb, Colb).Value
ReDim Tabc(1 To UBound(Tablo), 1)
' COMPARAISON DES DATAS CHARGEES DANS LES TABLEAUX
For I = LBound(Tablo) To UBound(Tablo)
For J = LBound(Tabb) To UBound(Tabb)
If Tablo(I, 1) = Tabb(J, 1) Then
Tabc(I, 1) = Tablo(I, 1)
End If
Next J
Next I
Kc = 1
' RESTITUTION DES ITEMS COMMUNS EN FEUIL7
Feuil7.Cells(1, 1) = Feuil2.Cells(1, 1)
For I = LBound(Tabc) To UBound(Tabc)
If Tabc(I, 1) <> vbNullString Then
Feuil7.Cells(Kc + 1, Cola) = Tabc(I, 1)
Kc = Kc + 1
End If
Next
Set Sbd1 = Nothing: Set Sbd2 = Nothing
Erase Tablo: Erase Tabb
' COPIE DES ITEMS COMMUNS DANS FEUIL7
Call Transfertcommuns
Erase Tabc
Application.GoTo reference:=Feuil7.Cells(2, 1), Scroll:=True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Public Sub Transfertcommuns()
' COPIE DES PLAGES DES ITEMS COMMUNS DANS FEUIL7
' COPIE DES DATAS DE LA FEUILLE BASE1
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Tabuniq As Variant, Vardatas As Variant
Dim K&, Kf&, Col&
Col = 1
K = Feuil2.Cells(65536, Col).End(xlUp).Row
Kf = Feuil7.Cells(65536, Col).End(xlUp).Row
Tabuniq = Feuil7.Cells(1, Col).Resize(K, Col).Value
Vardatas = Feuil2.Cells(1, Col).Resize(K, Vcol).Value
For K = LBound(Vardatas) To UBound(Vardatas)
For Kf = LBound(Tabuniq, 1) To UBound(Tabuniq, 1)
If Vardatas(K, 1) = Tabuniq(Kf, 1) Then
Feuil7.Cells(Kf, 2) = Vardatas(K, 2)
Feuil7.Cells(Kf, 3) = Vardatas(K, 3)
Feuil7.Cells(Kf, 4) = Vardatas(K, 4)
Feuil7.Cells(Kf, Vcol) = Vardatas(K, Vcol)
End If
Next Kf
Next K
Application.Calculation = xlCalculationAutomatic
Erase Vardatas: Erase Tabuniq
End Sub
Ce code me permet de comparer les feuilles 2 et 3 de mon classeur et de copier les lignes en communs dans la feuille 7
Le probleme est qu'il travail sur les feuilles du claseur en cours, et mon but est de faire ceci sur des feuille situées dans d'autres fichier, sans les ouvrir si possible.
j'ai vu que c'était possible grace à la commande "Workbooks.Open", mais je n'arrive pas à m'en servir par inexpérience.
Merci de votre aide.