Autres Copier des données vers une nouvelle feuille excel VBA

Carolinebd · 29 Novembre 2024

Bonjour

Je suis débutante dans le VBA et j'ai créer ce macro. dans excel 2007

Par contre, la copie fonctionne mais lorsque je rajoute les "if" cela ne fonctionne plus

Sub LACEY()

Dim Source As Worksheet
Dim target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Shipping List")
Set Tarket = ActiveWorkbook.Worksheets("LACEY")

' Only if they have a number in the cell
If Worksheets("Shipping List").Range("N12:N1519").Value > 0 Then

Also

' Only need lacey active, DO NOT COPY if cell indicate "N/A"
If Worksheets("Shipping List").Cells("E12:E1519") = ("CAP" Or "USA" Or "SPF" Or "LAM" Or LVL) Then

'Range.Copy Shipping list to Lacey
Worksheets("Shipping List").Range("H12:H1519").Copy Worksheets("LACEY").Range("C16")
Worksheets("Shipping List").Range("I12:I1519").Copy Worksheets("LACEY").Range("D16")
Worksheets("Shipping List").Range("E12:E1519").Copy Worksheets("LACEY").Range("B16")

'Multiply Worksheets("Shipping List").Range("I12:I1519") by Worksheets("Shipping List").Range("N12:N1519")

End If

End Sub

fanfan38 · 29 Novembre 2024

Bonjour et bienvenu sur le forum
Un fichier est TOUJOURS le bienvenu
Pour mettre du code cliquer d'abord sur </> dans le menu
Pourquoi nommer des feuilles si c'est pas pour utiliser ces noms?
Je pense qu'une boucle serait nécessaire

VB:

Sub LACEY()

Dim Source As Worksheet
Dim target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Shipping List")
Set Tarket = ActiveWorkbook.Worksheets("LACEY")

' Only if they have a number in the cell
If somme(Source.Range("N12:N1519")) > 0 Then
else
' Only need lacey active, DO NOT COPY if cell indicate "N/A"
If Source.Cells("E12:E1519") = ("CAP" Or "USA" Or "SPF" Or "LAM" Or LVL) Then
'Range.Copy Shipping list to Lacey
Source.Range("H12:H1519").Copy Worksheets("LACEY").Range("C16")
Source.Range("I12:I1519").Copy Tarket.Range("D16")
Source.Range("E12:E1519").Copy Tarket.Range("B16")
'Multiply Source.Range("I12:I1519") by Source.Range("N12:N1519")
End If
End Sub

A+ François

AtTheOne · 29 Novembre 2024

Bonsoir à toutes & à tous, bonsoir @Carolinebd, bonsoir @fanfan38
Bon j'ai interprété le pseudo code que tu nous as fourni. Comme le dit @fanfan38 je crois qu'il s'agit de faire une boucle sur toutes les cellules de la plage source.
' Only if they have a number in the cell :
On teste si la cellule de la plage en colonne "N" est numérique et supérieur à 0 (avec la fonction excel ISNUMBER pour écarter le cellules vides
'Also :
Moi j'interprète le "also" comme une condition supplémentaire :
On teste si la cellule correspondante de la colonne "E" est égale à une des valeurs "CAP", "USA", "SPF", "LAM", "LVL"
Si c'est le cas on procède à la copie, sinon on ne fait rien la cible commence en "B16 : D16" et se décale vers le bas progressivement.

MAIS TOUT ÇA CE NE SONT QUE DES SUPPOSITIONS !

Voilà le code que je propose :

VB:

Sub CopierSousConditions()

     Dim Source As Worksheet, Cible As Worksheet, Rg As Range, i%
     Set Source = ActiveWorkbook.Worksheets("Shipping List")
     Set Cible = ActiveWorkbook.Worksheets("LACEY")
     Set RgCible = Cible.Range("B16")
     RgCible.Resize(1508, 3).Clear
 
     Application.ScreenUpdating = False
     i = 0
     For Each C In Source.Range("N12:N1519").Cells
          If WorksheetFunction.IsNumber(C) Then
               If C.Value > 0 Then
                    Select Case C.Offset(0, -9).Value
                         Case "CAP", "USA", "SPF", "LAM", "LVL"
                              C.Offset(0, -9).Copy Destination:=RgCible.Offset(i, 0)
                              C.Offset(0, -6).Copy Destination:=RgCible.Offset(i, 1)
                              C.Offset(0, -5).Copy Destination:=RgCible.Offset(i, 2)
                              i = i + 1
                         Case Else
                              'Rien
                    End Select
               End If
          End If
     Next
     Application.Goto RgCible
     Application.ScreenUpdating = False
 
End Sub

Remarque : On peut nettement accélérer l'exécution s'il ne faut pas copier les formats et qu'on ne s’intéresse qu'aux valeurs, à toi de dire

Voir le fichier joint en PJ

Carolinebd · 2 Décembre 2024

fanfan38 à dit:

Bonjour et bienvenu sur le forum
Un fichier est TOUJOURS le bienvenu
Pour mettre du code cliquer d'abord sur </> dans le menu
Pourquoi nommer des feuilles si c'est pas pour utiliser ces noms?
Je pense qu'une boucle serait nécessaire

VB:

Sub LACEY()

Dim Source As Worksheet
Dim target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Shipping List")
Set Tarket = ActiveWorkbook.Worksheets("LACEY")

' Only if they have a number in the cell
If somme(Source.Range("N12:N1519")) > 0 Then
else
' Only need lacey active, DO NOT COPY if cell indicate "N/A"
If Source.Cells("E12:E1519") = ("CAP" Or "USA" Or "SPF" Or "LAM" Or LVL) Then
'Range.Copy Shipping list to Lacey
Source.Range("H12:H1519").Copy Worksheets("LACEY").Range("C16")
Source.Range("I12:I1519").Copy Tarket.Range("D16")
Source.Range("E12:E1519").Copy Tarket.Range("B16")
'Multiply Source.Range("I12:I1519") by Source.Range("N12:N1519")
End If
End Sub

A+ François

Je vous remercie je vais prendre des informations sur la boucle

Carolinebd · 2 Décembre 2024

AtTheOne à dit:
Bonsoir à toutes & à tous, bonsoir @Carolinebd, bonsoir @fanfan38
Bon j'ai interprété le pseudo code que tu nous as fourni. Comme le dit @fanfan38 je crois qu'il s'agit de faire une boucle sur toutes les cellules de la plage source.
' Only if they have a number in the cell :
On teste si la cellule de la plage en colonne "N" est numérique et supérieur à 0 (avec la fonction excel ISNUMBER pour écarter le cellules vides
'Also :
Moi j'interprète le "also" comme une condition supplémentaire :
On teste si la cellule correspondante de la colonne "E" est égale à une des valeurs "CAP", "USA", "SPF", "LAM", "LVL"
Si c'est le cas on procède à la copie, sinon on ne fait rien la cible commence en "B16 : D16" et se décale vers le bas progressivement.

MAIS TOUT ÇA CE NE SONT QUE DES SUPPOSITIONS !

Voilà le code que je propose :

VB:

Sub CopierSousConditions() Dim Source As Worksheet, Cible As Worksheet, Rg As Range, i% Set Source = ActiveWorkbook.Worksheets("Shipping List") Set Cible = ActiveWorkbook.Worksheets("LACEY") Set RgCible = Cible.Range("B16") RgCible.Resize(1508, 3).Clear Application.ScreenUpdating = False i = 0 For Each C In Source.Range("N12:N1519").Cells If WorksheetFunction.IsNumber(C) Then If C.Value > 0 Then Select Case C.Offset(0, -9).Value Case "CAP", "USA", "SPF", "LAM", "LVL" C.Offset(0, -9).Copy Destination:=RgCible.Offset(i, 0) C.Offset(0, -6).Copy Destination:=RgCible.Offset(i, 1) C.Offset(0, -5).Copy Destination:=RgCible.Offset(i, 2) i = i + 1 Case Else 'Rien End Select End If End If Next Application.Goto RgCible Application.ScreenUpdating = False End Sub

Remarque : On peut nettement accélérer l'exécution s'il ne faut pas copier les formats et qu'on ne s’intéresse qu'au valeurs, à toi de dire

Voir le fichier joint en PJ

Bonjour,

Oui j'ai tenté de faire comme je peux avec ce que je connaissait je ne connaissais pas les boucles mais je vais m'en informer.
Effectivement, le If est des conditions supplémentaire pour dire si la copie se fait ou non.
Le format n'est pas obligatoire mais ce n'est pas grave non plus.

Je vais étudier votre code pour le comprendre pour une prochaine fois ou si j'ai des choses à lui ajouter
un énorme merci.

Carolinebd · 2 Décembre 2024

Carolinebd à dit:
Bonjour,

Oui j'ai tenté de faire comme je peux avec ce que je connaissait je ne connaissais pas les boucles mais je vais m'en informer.
Effectivement, le If est des conditions supplémentaire pour dire si la copie se fait ou non.
Le format n'est pas obligatoire mais ce n'est pas grave non plus.

Je vais étudier votre code pour le comprendre pour une prochaine fois ou si j'ai des choses à lui ajouter
un énorme merci.

Rebonjour @AtTheOne ,

Je comprends bien votre code et comment vous l'avez défini. Le "C" est défini pour la colonne N.
Je comprends aussi pourquoi @fanfan38 à dit que je nommais mes feuilles et que je ne l'utilisais pas je vois maintenant comment je dois l'écrire je crois que j'avais mal compris les exemple que j'avais lu.

Par contre, je ne comprends pas à quoi sert le "I".

Il me manque 1 chose à faire.
Que je n'arrive pas J'aimerais que le chiffre "1" soit indiquer dans ma colonne "A" de la feuille Lacey pour chaque item qui se copie.

Je vous remercie d'avance

AtTheOne · 2 Décembre 2024

Bonsoir à toutes & à tous , bonsoir @Carolinebd
Je suis sur mon téléphone, dès que je retrouve mon PC je regarde ta demande et te donne quelques explications sur le bout de code que j'ai écrit
À bientôt
PS ce n'est pas ton post#5 qu'il faut marquer comme solution mais le post qui t'apporte la solution

AtTheOne · 3 Décembre 2024

Bonjour à toutes & à tous, bonjour @Carolinebd
Je t'ai mis en pièce jointe une version avec des codes commentés qui prennent en compte ta nouvelle demande (mettre des 1 en colonne A).

Il y a 2 versions de la macro :

Une qui recopie les cellules avec leur format
Une qui ne transfère que les valeurs

Tu verras le temps d'exécution de la 2ième n'a rien à voir avec celui de la 1ère.

Carolinebd à dit:
Par contre, je ne comprends pas à quoi sert le "I".

Et bien il sert à changer la ligne ou l'on copie les données (à chaque fois que l'on copie une ligne on incrémente i pour, la fois suivante, écrire sur la ligne du dessous.)

À bientôt

Carolinebd · 3 Décembre 2024

AtTheOne à dit:
Bonjour à toutes & à tous, bonjour @Carolinebd
Je t'ai mis en pièce jointe une version avec des codes commentés qui prennent en compte ta nouvelle demande (mettre des 1 en colonne A).

Il y a 2 versions de la macro :

Une qui recopie les cellules avec leur format

Une qui ne transfère que les valeurs

Tu verras le temps d'exécution de la 2ième n'a rien à voir avec celui de la 1ère.

Et bien il sert à changer la ligne ou l'on copie les données (à chaque fois que l'on copie une ligne on incrémente i pour, la fois suivante, écrire sur la ligne du dessous.)

À bientôt

Wow Merci énormément pour toutes votre aide
Les solutions apportés et explications celà va m'aider beaucoup à avancer dans ma démarches de créations de macro.
Bonne journée,

AtTheOne · 3 Décembre 2024

Re,
Merci pour le retour et à bientôt !

Carolinebd · 4 Décembre 2024

@AtTheOne
Bonjour à nouveau,

J'ai ajouté des lignes à votre macro pour ce qui est des lignes à copier/coller pour compléter mon tableau et tout fonctionne à merveille.
J'ai aussi affecter cette macro à un autre bouton de contrôle en changeant mon RGSource et RGcible. Encore une fois rien à redire et tout fonctionne.

C'est lorsque je suis venu pour l'appliquer à un 3e bouton de contrôle que celà ne fonctionnait plus.
Mais en réalité la partie ou est ce que le débugger me dit que sa ne fonctionne pas c'est à la fin.

Code:

Rgcible.Resize(i, 5).Value2 = Application.Transpose(Résultats)

'On attribue à la plage cible redimensionnée les résultats
'(on utilise la fonction TRANSPOSE pour passer le tableau en lignes, colonnes)
Rgcible.Resize(i, 5).Value2 = Application.Transpose(Résultats)

Application.Goto Rgcible.Offset(-1, 0), True
Application.ScreenUpdating = False

Est-ce que c'est parce que mon Rg source est trop gros?
Il s'étend de cette manière.

VB:

"Set RgSource = Source.Range("E12:AB2019") 'Plage contenant toutes les données"

Est-ce que je devrais le séparé en 2 pour que la macro est moi de recherche à faire? Soit mettre un range de ("E12:H12") et l'autre de (X12:AB12")

Ou bien cela n'a aucune incidence..

Je vous remercie d'avance

AtTheOne · 4 Décembre 2024

Bonsoir @Carolinebd et bonsoir à toutes & à tous !

Peux-tu joindre un exemple de ton travail ou au moins le texte complet de ta macro ? Cela nous faciliterait la tâche !

Le tableau "Résultats" doit être trop important pour la fonction TRANSPOSE, dans ce cas il faut faire une transposition par code.

L'idée est que comme tu connais les dimensions du tableau "Résultats"
(respectivement UBound(Résultats,1) et UBound(résultats,2)),
tu vas transposer son contenu dans un nouveau tableau en inversant lignes et colonnes :

VB:

...
NbL=UBound(Résultats,2)
NbC=Ubound(Résultats,1)
ReDim NouveauRés(1 to NbL, 1 to NbC)
For i = 1 to NbL
    For j = 1 to NbC
        NouveauRés(i,j)=Résultats(j,i)
    Next j
Next i
Rgcible.Resize(NbL, NbC).Value2 = NouveauRés
...

J'écris directement dans l'éditeur de Excel Downloads sans pouvoir tester dans EXCEL, mais cela devrait fonctionner.

À bientôt

AtTheOne · 4 Décembre 2024

Re,
Quelle version d'EXCEL utilises-tu ?

AtTheOne · 5 Décembre 2024

Bonjour @Carolinebd et bonjour à toutes & à tous !

Bon, en attendant tes réponses, je suis passé sur mon PC et j'ai fait la modification :

VB:

Sub CopierSousConditionsSansFormats()

     Dim Source As Worksheet, Cible As Worksheet, RgSource As Range, RgCible As Range
     Dim Données(), Résultats(), NewRés()
     Dim i As Long, j As Long, NbL As Long, NbC As Long
     Const NbColRés = 4
     
     Set Source = ActiveWorkbook.Worksheets("Shipping List")
     Set Cible = ActiveWorkbook.Worksheets("LACEY")
     
     Set RgSource = Source.Range("E12:N1519") 'Plage contenant toutes les données
     Set RgCible = Cible.Range("A16")         '1ère cellule de la plage cible
     
     Application.ScreenUpdating = False
     
     'On nettoie la cible (valeurs et formats)
     RgCible.Resize(Cible.Rows.Count - RgCible.Row + 1, NbColRés).Clear
     
     'on stocke dans un tableau de variables toutes les valeurs de la plage de données
     Données = RgSource.Value2
     
     'i : Index pour de décalage en ligne de la plage cible
     i = 0
     
     For j = 1 To UBound(Données, 1)  'J varie de 1 aux nombre de lignes de la plage des données (ici 1508 lignes)
          
          If IsNumeric(Données(j, 10)) And Not IsEmpty(Données(j, 10)) Then
               If Données(j, 10) > 0 Then
                    'Ici Données(j,10) est une valeur numérique supérieure à 0
                    
                    Select Case Données(j, 1)
                         Case "CAP", "USA", "SPF", "LAM", "LVL"
                              'On incrémente i pour le prochain résultat
                              i = i + 1
                              'On redimensionne le tableau Résultats et on le remplit (au début i vaut 1)
                              '————————————————————————————————————————————————————————————————————————————
                              'Remarque : le tableau est en colonnes-lignes et non pas en lignes-colonnes
                              '————————————————————————————————————————————————————————————————————————————
                              ReDim Preserve Résultats(1 To NbColRés, 1 To i)
                              Résultats(1, i) = 1
                              Résultats(2, i) = Données(j, 1)
                              Résultats(3, i) = Données(j, 4)
                              Résultats(4, i) = Données(j, 5)
                              
                         Case Else
                             'Rien
                    End Select
               End If
          End If
     Next
     
     'On transpose les résultats pour passer dans un tableau en lignes, colonnes
     NbL = UBound(Résultats, 2) 'Nbre de lignes = dimension 2 du tableau Résultats
     NbC = UBound(Résultats, 1) 'Nbre de colonnes = dimension 1 du tableau Résultats
     'Nouveau tableau de Résultats
     ReDim NewRés(1 To NbL, 1 To NbC)
     'Transposition
     For i = 1 To NbL
          For j = 1 To NbC
               NewRés(i, j) = Résultats(j, i)
          Next j
     Next i
     
     'On attribue à la plage cible redimensionnée les résultats
     RgCible.Resize(NbL, NbC).Value2 = NewRés
     
     'On se positionne juste au dessus de la cellule cible (True : avec défilement d'écran)
     Application.Goto RgCible.Offset(-1, 0), True
     
     Application.ScreenUpdating = True
     
End Sub

Voir la pièce jointe
À bientôt

Carolinebd · 5 Décembre 2024

AtTheOne à dit:
Bonsoir @Carolinebd et bonsoir à toutes & à tous !

Peux-tu joindre un exemple de ton travail ou au moins le texte complet de ta macro ? Cela nous faciliterait la tâche !

Le tableau "Résultats" doit être trop important pour la fonction TRANSPOSE, dans ce cas il faut faire une transposition par code.

L'idée est que comme tu connais les dimensions du tableau "Résultats"
(respectivement UBound(Résultats,1) et UBound(résultats,2)),
tu vas transposer son contenu dans un nouveau tableau en inversant lignes et colonnes :

VB:

... NbL=UBound(Résultats,2) NbC=Ubound(Résultats,1) ReDim NouveauRés(1 to NbL, 1 to NbC) For i = 1 to NbL For j = 1 to NbC NouveauRés(i,j)=Résultats(j,i) Next j Next i Rgcible.Resize(NbL, NbC).Value2 = NouveauRés ...

J'écris directement dans l'éditeur de Excel Downloads sans pouvoir tester dans EXCEL, mais cela devrait fonctionner.

À bientôt

Je suis sur excel 2007
Si je repart de la macro que vous m'avez fourni ça donne cela.

Sub LOAD3()

Dim Source As Worksheet, Cible As Worksheet, RgSource As Range, Rgcible As Range, i%
Dim Données(), Résultats()

Set Source = ActiveWorkbook.Worksheets("Shipping List")
Set Cible = ActiveWorkbook.Worksheets("LACEY")

Set RgSource = Source.Range("E12:AB2019") 'Plage contenant toutes les données
Set Rgcible = Cible.Range("N23") '1ère cellule de la plage cible

'On nettoie la cible (valeurs et formats)
Rgcible.Resize(2008, 5).Clear

Application.ScreenUpdating = False

'on stocke dans un tableau de variables toutes les valeurs de la plage de données
Données = RgSource.Value2

'i : Index pour de décalage en ligne de la plage cible
i = 0

For j = 1 To UBound(Données, 1) 'J varie de 1 aux nombre de lignes de la plage des données (ici 2008 lignes)

If IsNumeric(Données(j, 20)) And Not IsEmpty(Données(j, 20)) Then
If Données(j, 20) > 0 Then
'Ici Données(j,20) est une valeur numérique supérieure à 0

Select Case Données(j, 1)
Case "CAP", "USA", "SPF", "LAM", "LVL", "PLY"
'On incrémente i pour le prochain résultat
i = i + 1
'on redimentionne le tableau Résultats et on le remplit (au début i vaut 1)
'remarque le tableau est en colonnes, lignes et non pas en lignes, colonnes
ReDim Preserve Résultats(1 To 5, 1 To i)
Résultats(1, i) = 3
Résultats(2, i) = Données(j, 1)
Résultats(3, i) = Données(j, 4)
Résultats(4, i) = Données(j, 24)
Résultats(5, i) = Données(j, 20)

Case Else
'Rien
End Select
End If
End If
Next

'On attribue à la plage cible redimensionnée les résultats
'(on utilise la fonction TRANSPOSE pour passer le tableau en lignes, colonnes)
Rgcible.Resize(i, 5).Value2 = Application.Transpose(Résultats)

Application.Goto Rgcible.Offset(-1, 0), True
Application.ScreenUpdating = False

End Sub

Autres Copier des données vers une nouvelle feuille excel VBA

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Accro

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Accro

XLDnaute Accro

Pièces jointes

XLDnaute Nouveau

XLDnaute Accro

XLDnaute Nouveau

XLDnaute Accro

XLDnaute Accro

XLDnaute Accro

Pièces jointes

XLDnaute Nouveau

Discussions similaires

Partager cette page

Statistiques des forums