EXCEL 2007 VBA
coolmek2014
Messages postés
6
Date d'inscription
Statut
Membre
Dernière intervention
-
michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention -
Bjr à ts,
J'ai un code qui permet de copier des colonnes d'une feuille à une autre sous condition, mais j'ai tjts des erreurs, quelqu'un pourra m'aider, ci dessous le code :
Sub maj()
Dim derlig As Long, lig As Long, col As Long, datas As Variant
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Dim cpt1 As Long, cpt2 As Long, inconnu As Long, msg As String
Set sh1 = Sheets("Feuil1")
Set sh2 = Sheets("Feuil2")
'recup datas
With sh1
derlig = .Cells(Rows.Count, "R").End(xlUp).Row
datas = .[A2].Resize(derlig - 1, 18)
End With
' traitement
Application.ScreenUpdating = False
For lig = 1 To UBound(datas)
If LCase(datas(lig, 16)) = "oui" Then
cpt1 = cpt1 + 1
Set c = sh2.[A:A].Find(datas(lig, 1), LookIn:=xlValues, Lookat:=xlWhole)
If c Is Nothing Then
inconnu = inconnu + 1
Else
sh2.Cells(c.Row, 8) = datas(lig, 11)
sh2.Cells(c.Row, 9) = datas(lig, 12)
sh2.Cells(c.Row, 10) = datas(lig, 13)
sh2.Cells(c.Row, 11) = datas(lig, 14)
sh2.Cells(c.Row, 14) = Now
End If
Else
cpt2 = cpt2 + 1
End If
Next lig
msg = "Oui : " & vbTab & cpt1 & vbLf
msg = msg & "Autres : " & vbTab & cpt2 & vbLf & vbLf
msg = msg & "Références 'Oui' non trouvées : " & inconnu
MsgBox msg
End Sub
J'ai un code qui permet de copier des colonnes d'une feuille à une autre sous condition, mais j'ai tjts des erreurs, quelqu'un pourra m'aider, ci dessous le code :
Sub maj()
Dim derlig As Long, lig As Long, col As Long, datas As Variant
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Dim cpt1 As Long, cpt2 As Long, inconnu As Long, msg As String
Set sh1 = Sheets("Feuil1")
Set sh2 = Sheets("Feuil2")
'recup datas
With sh1
derlig = .Cells(Rows.Count, "R").End(xlUp).Row
datas = .[A2].Resize(derlig - 1, 18)
End With
' traitement
Application.ScreenUpdating = False
For lig = 1 To UBound(datas)
If LCase(datas(lig, 16)) = "oui" Then
cpt1 = cpt1 + 1
Set c = sh2.[A:A].Find(datas(lig, 1), LookIn:=xlValues, Lookat:=xlWhole)
If c Is Nothing Then
inconnu = inconnu + 1
Else
sh2.Cells(c.Row, 8) = datas(lig, 11)
sh2.Cells(c.Row, 9) = datas(lig, 12)
sh2.Cells(c.Row, 10) = datas(lig, 13)
sh2.Cells(c.Row, 11) = datas(lig, 14)
sh2.Cells(c.Row, 14) = Now
End If
Else
cpt2 = cpt2 + 1
End If
Next lig
msg = "Oui : " & vbTab & cpt1 & vbLf
msg = msg & "Autres : " & vbTab & cpt2 & vbLf & vbLf
msg = msg & "Références 'Oui' non trouvées : " & inconnu
MsgBox msg
End Sub
A voir également:
- EXCEL 2007 VBA
- Save as pdf office 2007 - Télécharger - Bureautique
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Déplacer colonne excel - Guide
- Si ou excel - Guide