XL 2019 copier coller vba

frederio

frederio

XLDnaute Impliqué
Bonjour a tous,

Sur la 1ère feuille " JUPILER PRO LEAGUE" Copie =G4:H375
Sur la 2ère feuille " %" Coller =I5:J409

MERCI
 

Pièces jointes

  • COPIE COLLER.xlsm
    854.6 KB · Affichages: 8
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Bonjour frederio,

Formule matricielle en I5 :
Code: 
=INDEX('JUPILER PRO LEAGUE'!G:G;EQUIV($H5&$K5;'JUPILER PRO LEAGUE'!$F$1:$F$375&'JUPILER PRO LEAGUE'!$I$1:$I$375;0))
à valider par Ctrl+Maj+Entrée et à copier sur J5 puis vers le bas.

A+
 

Pièces jointes

  • COPIE COLLER.xlsm
    854 KB · Affichages: 3
Vote positif 0 Vote négatif
frederio

frederio

XLDnaute Impliqué
COMMENT FAIRE Sur la 2ère feuille " %" Coller =I5:J409



VB: 
Sub sbCopyRangeToAnotherSheet()
'Set range
Sheets("JUPILER PRO LEAGUE").Range("G4:H12").Copy Destination:=Sheets("%").Range("I5")
'Copy the data
Sheets("JUPILER PRO LEAGUE").Range("G4:H12").Copy
'Activate the destination worksheet
Sheets("%").Activate
'Select the target range
Range("I5").Select
'Paste in the target destination
ActiveSheet.Paste

Application.CutCopyMode = False
End Sub
 

Pièces jointes

  • COPIE COLLER (2).xlsm
    853.9 KB · Affichages: 1
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Il est beaucoup plus simple d'utiliser les formules suivantes :

- en H5, à copier-coller sur I5:K5 et vers le bas :
Code: 
=INDEX('JUPILER PRO LEAGUE'!F:F;LIGNE()-1-ENT((LIGNE()-5)/12))
- en G17, à copier-coller vers le bas :
Code: 
=INDEX('JUPILER PRO LEAGUE'!D:D;LIGNE()-1-ENT((LIGNE()-5)/12))
- en L17, à copier-coller vers le bas :
Code: 
=INDEX('JUPILER PRO LEAGUE'!K:K;LIGNE()-1-ENT((LIGNE()-5)/12))
Ensuite il suffit de copier le tableau G17:L25 et de le coller sur les tableaux en dessous.

Bonne nuit.
 

Pièces jointes

  • COPIE COLLER(1).xlsm
    848.3 KB · Affichages: 4
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour frederio, le forum,

La solution par formules précédente est la plus simple et donc la meilleure.

Mais si vous tenez absolument au VBA mettez cette macro dans le code de la feuille "%" :
VB: 
Private Sub Worksheet_Activate()
Dim deb As Range, pas%, tablo, ncol%, resu, i&, ii&, jj%, j%, n&
Set deb = [G4] '1ère cellule de restitution, à adapter
pas = 11 'nombre de lignes de chaque journée
With Sheets("JUPILER PRO LEAGUE")
    tablo = .Range("D3", .Range("K" & .Rows.Count).End(xlUp))
    ncol = UBound(tablo, 2)
    ReDim resu(1 To UBound(tablo) + Application.CountIf(.[F:F], "JOURNEE*"), 1 To ncol - 2)
End With
'---remplissage du tableau et mises en forme---
Application.ScreenUpdating = False
deb.Resize(pas - 1, ncol - 2).ClearContents 'efface le contenu de la 1ère journée
For i = 1 To UBound(tablo)
    ii = ii + 1
    If i Mod pas = 1 Then '1ère ligne de chaque journée
        If i > 1 Then
            deb.EntireRow.Copy deb(ii).EntireRow 'copie la 1ère ligne
            deb(2).Resize(pas - 2, ncol - 2).Copy deb(ii + 1) 'copie la 1ère journée pour les formats
        End If
        deb(ii, 12).Resize(pas - 1).BorderAround Weight:=xlMedium 'contour colonne R
        n = n + 1
        resu(ii, 1) = "JOURNEE"
        resu(ii, ncol - 2) = n
    Else
        jj = 0
        For j = 1 To ncol
            jj = jj + 1
            resu(ii, jj) = tablo(i, j)
            If j = 1 Then j = 2 'saut de colonne
            If j = ncol - 2 Then j = ncol - 1 'saut de colonne
        Next j
    End If
    If i Mod pas = pas - 1 Then i = i + 1: ii = ii + 2 'sauts de lignes
Next i
ii = ii - 2 'évite les derniers sauts de lignes
'---restitution---
deb.Resize(ii, ncol - 2) = resu
deb.Offset(ii).EntireRow.Resize(Rows.Count - ii - deb.Row + 1).Delete 'RAZ en dessous
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
Elle s'exécute quand on active la feuille, testez ce fichier (2).

Ce n'est quand même pas très simple.

A+
 

Pièces jointes

  • COPIE COLLER(2).xlsm
    642.3 KB · Affichages: 8
Vote positif 0 Vote négatif
frederio

frederio

XLDnaute Impliqué
bonjour job

Activez la feuille "%"
Copie
Sur la 1ère feuille " JUPILER PRO LEAGUE" Copie =G4:H375
Coller
Sur la 2ère feuille " %" Coller =I5:J409


NE PAS TOUCHER

Sur la 1ère feuille " JUPILER PRO LEAGUE" Copie =D3:K375

Sur la 2ère feuille " %" Coller =G4:L409

PEUX TOUCHER
Sur la 1ère feuille " JUPILER PRO LEAGUE" Copie =G4:H375 ET Sur la 2ère feuille " %" Coller =I5:J409
 
Vote positif 0 Vote négatif
frederio

frederio

XLDnaute Impliqué

comment faire plus rapide code vba​


VB: 
Sub sbCopyRangeToAnotherSheet()
'Set range
Sheets("JUPILER PRO LEAGUE").Range("G4:H12").Copy Destination:=Sheets("%").Range("I5")
'Copy the data
Sheets("JUPILER PRO LEAGUE").Range("G4:H12").Copy
'Activate the destination worksheet
Sheets("%").Activate
'Select the target range
Range("I5").Select
'Paste in the target destination
ActiveSheet.Paste

Sheets("JUPILER PRO LEAGUE").Range("G15:H23").Copy Destination:=Sheets("%").Range("I17")
'Copy the data
Sheets("JUPILER PRO LEAGUE").Range("G15:H23").Copy
'Activate the destination worksheet
Sheets("%").Activate
'Select the target range
Range("I17").Select
'Paste in the target destination

Sheets("JUPILER PRO LEAGUE").Range("G26:H34").Copy Destination:=Sheets("%").Range("I29")
'Copy the data
Sheets("JUPILER PRO LEAGUE").Range("G26:H34").Copy
'Activate the destination worksheet
Sheets("%").Activate
'Select the target range
Range("I29").Select
'Paste in the target destination
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour frederio, le forum,
frederio à dit:
comment faire plus rapide code vba
Cliquez pour agrandir...
La macro du post #5 s'exécute chez moi en 0,80 seconde et c'est vrai qu'on peut aller plus vite.

Dans ce fichier (3) la mise en forme des tableaux se fait d'un seul coup avant restitution des valeurs :
VB: 
Private Sub Worksheet_Activate()
Dim deb As Range, pas%, tablo, ncol%, resu, i&, ii&, n&, jj%, j%
Set deb = [G4] '1ère cellule de restitution, à adapter
pas = 11 'nombre de lignes de chaque journée
With Sheets("JUPILER PRO LEAGUE")
    tablo = .Range("D3", .Range("K" & .Rows.Count).End(xlUp))
    ncol = UBound(tablo, 2)
    ReDim resu(1 To UBound(tablo) + Application.CountIf(.[F:F], "JOURNEE*"), 1 To ncol - 2)
End With
'---remplissage du tableau---
For i = 1 To UBound(tablo)
    ii = ii + 1
    If i Mod pas = 1 Then '1ère ligne de chaque journée
        n = n + 1
        resu(ii, 1) = "JOURNEE"
        resu(ii, ncol - 2) = n
    Else
        jj = 0
        For j = 1 To ncol
            jj = jj + 1
            resu(ii, jj) = tablo(i, j)
            If j = 1 Then j = 2 'saut de colonne
            If j = ncol - 2 Then j = ncol - 1 'saut de colonne
        Next j
    End If
    If i Mod pas = pas - 1 Then i = i + 1: ii = ii + 2 'sauts de lignes
Next i
ii = ii - 2 'évite les derniers sauts de lignes
'---mise en forme et restitution---
Application.ScreenUpdating = False
deb.Resize(pas - 1, ncol - 2) = "" 'efface le contenu de la 1ère journée
deb.EntireRow.Resize(pas + 1).Copy deb(pas + 2).EntireRow.Resize((n - 1) * (pas + 1)) 'copier-coller pour la mise en formex
deb.Resize(ii, ncol - 2) = resu
deb.Offset(ii).EntireRow.Resize(Rows.Count - ii - deb.Row + 1).Delete 'RAZ en dessous
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
La macro s'exécute chez moi en 0,11 seconde.

A+
 

Pièces jointes

  • COPIE COLLER(3).xlsm
    641.2 KB · Affichages: 2
Dernière édition:
Vote positif 0 Vote négatif
frederio

frederio

XLDnaute Impliqué
c est petite problème jaune
2022-04-16_14-08-39.png
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Il n'y a pas de problème chez moi mais bon remplacez :
VB: 
deb.Resize(pas - 1, ncol - 2).ClearContents 'efface le contenu de la 1ère journée
par :
Code: 
deb.Resize(pas - 1, ncol - 2) = "" 'efface le contenu de la 1ère journée
Je corrige le post #10, prenez le dernier fichier.
 
Vote positif 0 Vote négatif

Discussions similaires

frederio
  • Question
XL 2019 direct plus rapide
Réponses
5
Affichages
524
frederio
frederio
frederio
  • Question
XL 2019 SIERREUR(et ;"")
Réponses
3
Affichages
435
fanch55
fanch55
frederio
  • Question
XL 2019 SIERREUR(et ;"")
Réponses
8
Affichages
469
AtTheOne
AtTheOne
frederio
  • Question
XL 2019 Comment faire enlever
Réponses
3
Affichages
427
frederio
frederio
frederio
  • Question
XL 2019 C'est Problème SIERREUR(et ;"")
Réponses
5
Affichages
320
fanch55
fanch55
frederio
  • Question
XL 2019 Check Boxes copie / coller
Réponses
8
Affichages
447
frederio
frederio
frederio
  • Question
XL 2019 marche pas ouvert rouge
Réponses
2
Affichages
196
frederio
frederio
frederio
  • Question
XL 2019 Problème journée
Réponses
2
Affichages
329
frederio
frederio
frederio
  • Question
XL 2019 TOTAL DE BUTS et NOMBRE DE JOURNEE
Réponses
8
Affichages
711
frederio
frederio
frederio
  • Question
XL 2019 Méthodes et Techniques forum paris sportifs
Réponses
1
Affichages
714
Compte Supprimé 979
C

Membres actuellement en ligne

6 membres et 75 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 489
Messages
2 088 851
Membres
103 974
dernier inscrit
chmikha