Modification du code VBA

Le 24/08/2022 à 17:49

Aide à la modification du code vba

Bonjour..Je suis confronté à un problème lors de l'exécution du code, les colonnes M, O et N sont vidées même si la plage de vidage est spécifiée dans cette ligne. En couleur rouge. je ne sais pas pourquoi!!! Y at-il une solution à ce problème. Ou un autre code qui fait la même chose.

sh.Range("C10:L1000").ClearContents


Sub derc()
Dim arr As Variant
Dim temp As Variant
Dim cr As Variant
Dim lr As Long
Dim i As Long
Dim j As Long
Dim C As Long
Dim WS As Worksheet
Dim sh As Worksheet
Dim myArray, targt, targt2

Set Main = Sheets("sh1")
Set sh = Sheets("sh2")

targt = sh.Range("M5").Value & "*"
targt2 = sh.Range("M6").Value & "*"
'targt = "aa*"
'targt2 = "mm*"

sh.Range("C10:L1000").ClearContents

lr = Main.Cells(Rows.Count, 4).End(xlUp).Row

arr = Main.Range("A10:R" & lr).Value

ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2))

cr = Array(2, 4, 5, 7, 9, 10, 11, 12, 15)
j = 1
For i = LBound(arr, 1) To UBound(arr, 1)
'If arr(i, Like targt & "*" _
And arr(i, 89) Like targt2 & "*" Then
temp(j, 1) = j
For C = LBound(cr) To UBound(cr)
temp(j, C + 2) = arr(i, cr(C))
Next C
j = j + 1
Next i
With sh

.Range("C10").Resize(j - 1, UBound(temp, 2)).Value = temp

End With
End Sub
Le 25/08/2022 à 20:36

Bonjour Arwasoha,

Avec un fichier ... ce serait plus facile ...

Quand tu veux nous soumettre du code ... s.t.p. utilise le bouton </> et colle le code dans la fenêtre qui se présente ... merci de ta coopération ...

Est-ce que tu as tenté un pas-à-pas (touche F8) sur le code afin de voir en même temps ce qui se passe dans la feuille ??

ric

Le 25/08/2022 à 21:42

Merci beaucoup pour l'aide. J'ai créé ce code qui remplit l'objectif mais il est très lent Y a-t-il un bogue qui peut être corrigé

Sub mh()
Dim i As Integer
Application.ScreenUpdating = False
Sheets("data").Range("c10:l100").ClearContents
Sheets("saad").Select
lrow = Sheets("saad").Cells(Rows.Count, 2).End(xlUp).Row

For i = 1 To lrow + 10
Sheets("saad").Select
        Range("b" & i).Copy
        Sheets("data").Select
        Range("d" & llrow + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme

        Sheets("saad").Select
        Range("d" & i).Copy
       Sheets("data").Select
        Range("e" & llrow + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme

        Sheets("saad").Select
        Range("e" & i).Copy
        Sheets("data").Select
        Range("f" & llrow + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme

        Sheets("saad").Select
        Range("g" & i).Copy
        Sheets("data").Select
         Range("g" & llrow + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme

        Sheets("saad").Select
        Range("i" & i).Copy
        Sheets("data").Select
        Range("h" & llrow + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme

         Sheets("saad").Select
        Range("l" & i).Copy
        Sheets("data").Select
         Range("k" & llrow + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        Sheets("saad").Select
        Range("j" & i).Copy
        Sheets("data").Select
        Range("i" & llrow + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme

        Sheets("saad").Select
        Range("k" & i).Copy
        Sheets("data").Select
        Range("j" & llrow + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
         Sheets("saad").Select
        Range("o" & i).Copy
        Sheets("data").Select
         Range("l" & llrow + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        llrow = llrow + 1
        Next
End Sub

Je suis désolé, je ne sais toujours pas comment télécharger des fichiers sur le site

Le 25/08/2022 à 23:42

bonjour,

une proposition

Sub aargh()
    Dim i As Long
    Application.ScreenUpdating = False
    With Sheets("saad")
        Sheets("data").Range("c10:l100").ClearContents '????effacer la plage C10:L100 ???? pourquoi à partir de la ligne 10 et pas la ligne 1
        lrow = .Cells(Rows.Count, 2).End(xlUp).Row
        frt = Split("B,D,E,G,I,L,J,K,O", ",") ' colonne source
        tot = Split("D,E,F,G,H,K,I,J,L", ",") 'colonne de destination
        For i = LBound(frt) To UBound(frt)
            .Range(frt(i) & "1:" & frt(i) & lrow).Copy Sheets("Data").Range(tot(i) & "1") 'copie la colonne de la ligne 1 à la ligne lrow
        Next i
    End With
End Sub
Le 25/08/2022 à 23:53

Très bien. Une dernière question, s'il vous plaît, comment puis-je ajouter une séquence automatique dans la colonne c

Le 26/08/2022 à 00:30

bonsoir,

une adaptation du code pour y introduire la séquence.

Sub aargh()
    Dim i As Long
    Application.ScreenUpdating = False
    With Sheets("saad")
        Sheets("data").Range("c10:l100").ClearContents
        lrow = .Cells(Rows.Count, 2).End(xlUp).Row
        frt = Split("B,D,E,G,I,L,J,K,O", ",") ' colonne source
        tot = Split("D,E,F,G,H,K,I,J,L", ",") 'colonne de destination
        For i = LBound(frt) To UBound(frt)
            .Range(frt(i) & "1:" & frt(i) & lrow).Copy Sheets("Data").Range(tot(i) & "1") 'copie la colonne de la ligne 1 à la ligne lrow
        Next i
    End With
    'Sheets("data").Range("C1:C" & lrow) = Application.Evaluate("=row(A1:A" & lrow & ")")
    With Sheets("data")
        .Range("C1") = 1
        .Range("C2") = 2
        .Range("C1:C2").AutoFill .Range("C1:C" & lrow)
    End With
End Sub
Le 26/08/2022 à 01:28

Bonjour Arwasoha, h2so4, le forum,

h2so4 te donne un solution de type "Formule 1"...

Mais basé sur ton code ... juste en enlevant les .Select ... déjà l'on a un "Honda Civic Si" ... 

Sub mh()
Dim i As Integer
Application.ScreenUpdating = False
Sheets("data").Range("c10:l100").ClearContents
Sheets("saad").Activate    '' << pour les feuilles, utilise .Active  pas le Select
lrow = Sheets("saad").Cells(Rows.Count, 2).End(xlUp).Row

For i = 1 To lrow + 10
   Sheets("saad").Range("b" & i).Copy
   Sheets("data").Range("d" & llrow + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme

   Sheets("saad").Range("d" & i).Copy
   Sheets("data").Range("e" & llrow + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme

'...
'...
'...

ric

Rechercher des sujets similaires à "modification code vba"