Copier d'un tableau à autre tableau sur une autre feuille avec VBA
Bonsoir.
- Je souhaite enregistrer les lignes qui ont "NEGATIF" ou "POSITIF" de la colonne 'ETAT' dans Le tableau CLOTURE qui se trouve dans la feuille HISTORQUE AVEC VBA
NB: enregistrer uniquement les trois premières colonnes
Cordialement...
Bonjour Linsonn,
Un tas de sujets traite de votre problématique, il suffit d'effectuer une petite recherche
Vous pouvez aussi cliquez sur le bouton ci-dessous "Rechercher des sujets similaires..."
A+
Bonjour BrunoM45,
Je suis un désolé je ne suis pas un pro j'ai jeté un coup d'œil un peu partout pour trouver quelque chose que je peux comprendre et modifier. je souhaite vraiment votre soutien Mr BrunoM45.
Re,
Permettez moi quand même de m'interroger, au CIC ils n'ont pas une DSI avec des gens capables de le faire
Je suis franchement surpris qu'on vous laisse mettre ce genre de fichier (même sans donnée personnelle) sur un forum
A+
Bonsoir Mr Bruno vous exagérez un peu.
Je cherche de l'aide. Pour un programme que je suis en train de mettre sur pied. Je ne travaille pas pour une entreprise sinon je ne viendrai dans ce forum pour demander de l'aide.
STP, STP si tu peux me proposer un code qui effectue un copier-coller sous condition entre deux tableaux ce sera un bon pour moi (même avec un fichier que tu peux toi-même me proposer à l'occasion.)
Re,
Désolé, je n'exagère pas... pensez simplement à la confidentialité des fichiers déposés
Ce n'est pas moi qui l'invente
C'est une erreur j'ai certainement modifié un fichier présent sur ma machine que j'ai récupéré en ligne ou sur ce forum pour monter mon exemple sinon cette identité ne me concerne pas directement. Mr Bruno M45.
En bref je développe un algorithme sur le trading haute fréquence. Pour cela j'ai besoin d'analyser les bases de données des produits financiers et gérer des ordres en cours jusqu’à ce quelle soit RENTABLES.
Je ne travaille pas pour une structure le besoin est personnelle. J'avais déjà bidouillé une macro sur cette tache mais elle prend trop de temps.
Bonjour LINSONN, Bruno
Avec le filtre :
Option Explicit
Sub Copy()
Application.ScreenUpdating = False
With Sheets("Feuil2").Cells(5, 3).CurrentRegion
.Parent.AutoFilterMode = False
.AutoFilter 3, Array("NEGATIF", "POSITIF"), 7
With .Offset(1).Resize(, 3)
.Copy Sheets("HISTORIQUE").Range("c" & Rows.Count).End(xlUp)(2)
End With
.AutoFilter
End With
Application.ScreenUpdating = True
End SubAttention au nom de la feuille de destination.
klin89
Bonjour Klin89, BrunoM45
Mais j'ai du mal à adapter ce code à ma feuille.
Si je peux me permettre d'en demander plus. MRS KLIN89
Si je souhaite qu'il copie de la colonne "CO" à la colonne "CY" de la "Feuil2" si dans la colonne BR contient "NEGATIF" ou "POSITIF" STP: sur cette feuille les données commencent à la ligne 35.
Ensuite
Qu’il colle le résultat à partir de la colonne "b" de la feuille "HISTORQUE" STP: sur cette feuille les données commencent à la ligne 9.
Comment modifier cela
Merci pour tous...
Cordialement.
Bonjour à tous,
Pourquoi ne pas joindre un fichier exemple représentatif de tes données ?
Cordialement,
Bonjour xorsankukai,
Merci pour le retour...
J'ai mis le tableau à jour.
OJECTIF: COPIER de 'CO' à 'CY' si BR = "POSITIF" ou "NEGATIF" du tableau47 Feuille (Feuil2)
et Coller de 'B' à 'L' Tableau4849 Feuille ( HISTORQUE)
Cordialement...
Re,
Un essai....
Sub copy()
Dim tb, Newtb(), i&, k&, j, rcell As Range
With Sheets("Feuil2")
If Not .ListObjects(1).DataBodyRange Is Nothing Then
tb = .ListObjects(1).DataBodyRange
k = 0
ReDim Newtb(0 To UBound(tb, 1), 1 To 35)
For i = 1 To UBound(tb, 1)
If tb(i, 59) Like "POSITIF" Or tb(i, 59) Like "NEGATIF" Then
Newtb(k, 1) = tb(i, 1)
For j = 82 To 92
Newtb(k, j - 80) = tb(i, j): Next j
k = k + 1
End If
Next i
End If
End With
If k > 0 Then
With Sheets("HISTORQUE").ListObjects(1)
If .InsertRowRange Is Nothing Then
Set rcell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
Else
Set rcell = .InsertRowRange.Cells(1)
End If
End With
Application.DisplayAlerts = False
rcell.Resize(k, 35).Value = Newtb
Application.DisplayAlerts = True
MsgBox "Données enregistrées", vbInformation
Else
MsgBox "Aucunes données à transférer", vbExclamation
End If
Erase tb: Erase Newtb: Set rcell = Nothing
End SubCordialement,
Bonsoir Mr xorsankukai.
L'essai est impeccable.
Merci beaucoup.
Bonjour M xorsankukai.
J'ai du mal à modifier pour faire le schéma inverse
c’est-à-dire :
OJECTIF: si AB >= 1 COPIER de 'AJ' à 'AN' Coller de 'M' à 'Q' et
COPIER de 'AO' Coller de 'V' et COPIER de 'AP' Coller de 'AP'
La copie se fait entre le tableau4849 Feuille (HISTORQUE) et le Tableau47 Feuille ( Feuil2)
Cordialement...
J'ai commencé à modifier le code ci-dessous mais je suis resté là je ne comprends pas la suite de la macro.
J’ai joint le fichier à jour.
Sub copyyy()
Dim tb, Newtb(), i&, k&, j, rcell As Range
With Sheets("HISTORQUE")
If Not .ListObjects(1).DataBodyRange Is Nothing Then
tb = .ListObjects(1).DataBodyRange
k = 0
ReDim Newtb(0 To UBound(tb, 1), 1 To 8)
For i = 1 To UBound(tb, 1)
If tb(i, 42) Like "NEGATIF" Then
Newtb(k, 1) = tb(i, 1)
For j = 36 To 43
Newtb(k, j - 80) = tb(i, j): Next j
k = k + 1
End If
Next i
End If
End With
If k > 0 Then
With Sheets("Feuil2").ListObjects(1)
If .InsertRowRange Is Nothing Then
Set rcell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
Else
Set rcell = .InsertRowRange.Cells(1)
End If
End With
Application.DisplayAlerts = False
rcell.Resize(k, 35).Value = Newtb
Application.DisplayAlerts = True
Mégot "Données enregistrées", vbInformation
Else
MsgBox "Aucunes données à transférer", vbExclamation
End If
Erase tb: Erase Newtb: Set rcell = Nothing
End SubBonjour LINSONN, le forum,
Un nouvel essai....mais j'ai du mal à m'y retrouver....
Sub copyyy()
Dim tb, Newtb(), i&, k&, j, rcell As Range
With Sheets("HISTORQUE")
If Not .ListObjects(1).DataBodyRange Is Nothing Then
tb = .ListObjects(1).DataBodyRange
k = 0
ReDim Newtb(0 To UBound(tb, 1), 1 To 31)
For i = 1 To UBound(tb, 1)
If tb(i, 28) <> "" And tb(i, 28) >= 1 Then
Newtb(k, 1) = tb(i, 1) 'indice
For j = 36 To 40
Newtb(k, j - 34) = tb(i, j): Next j 'AJ:AN==> M:Q
Newtb(k, 11) = tb(i, 41) ' AO==> V
Newtb(k, 31) = tb(i, 42) ' AP==> AP
k = k + 1
End If
Next i
End If
End With
If k > 0 Then
With Sheets("Feuil2").ListObjects(1)
If .InsertRowRange Is Nothing Then
Set rcell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
Else
Set rcell = .InsertRowRange.Cells(1)
End If
End With
Application.DisplayAlerts = False
rcell.Resize(k, 31).Value = Newtb
Application.DisplayAlerts = True
MsgBox "Données enregistrées", vbInformation
Else
MsgBox "Aucunes données à transférer", vbExclamation
End If
Erase tb: Erase Newtb: Set rcell = Nothing
End SubCordialement,
Le code est sublime...
il réagit parfaitement.
En fin je souhaite supprimer les lignes "POSITIFS" et "NEGATIFS" à la fin de la macro 'copy' est ce que c'est possible ?
Re,
Cool,
En fin je souhaite supprimer les lignes "POSITIFS" et "NEGATIFS" à la fin de la macro 'copy' est ce que c'est possible ?
Si tu parles de cette macro :
On ne copie que les lignes qui contiennent "POSITIF" où "NEGATIF" dans la colonne BR de la Feuil2....
- tu souhaites faire l'inverse ? Copier uniquement les lignes qui ne contiennent pas... ?
- où ne pas copier mais supprimer ces lignes ?
Cordialement,
Oui la première macro
après la copie supprimer.
Re,
- On copie les données dans la feuille HISTORQUE
- On supprime les données copiées de la Feuil2
A tester:
Sub copyy()
Dim tb, Newtb(), i&, k&, j, rcell As Range
Application.ScreenUpdating = False
With Sheets("Feuil2")
If Not .ListObjects(1).DataBodyRange Is Nothing Then
tb = .ListObjects(1).DataBodyRange
k = 0
ReDim Newtb(0 To UBound(tb, 1), 1 To 12)
For i = 1 To UBound(tb, 1)
If tb(i, 59) Like "POSITIF" Or tb(i, 59) Like "NEGATIF" Then
Newtb(k, 1) = tb(i, 1)
For j = 82 To 92
Newtb(k, j - 80) = tb(i, j): Next j
k = k + 1
End If
Next i
With .ListObjects(1)
If .ShowAutoFilter Then .AutoFilter.ShowAllData
.Range.AutoFilter Field:=59, Criteria1:="=NEGATIF", Operator:=xlOr, Criteria2:="=POSITIF"
On Error Resume Next
Application.DisplayAlerts = False
.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
On Error GoTo 0
Application.DisplayAlerts = True
If .ShowAutoFilter Then .AutoFilter.ShowAllData
End With
If k > 0 Then
With Sheets("HISTORQUE").ListObjects(1)
If .InsertRowRange Is Nothing Then
Set rcell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
Else
Set rcell = .InsertRowRange.Cells(1)
End If
End With
Application.DisplayAlerts = False
rcell.Resize(k, 12).Value = Newtb
Application.DisplayAlerts = True
MsgBox "Données enregistrées", vbInformation
Else
MsgBox "Aucunes données à transférer", vbExclamation
End If
End If
End With
Erase tb: Erase Newtb: Set rcell = Nothing
End SubIl y a certainement moyen de simplifier........
Cordialement,