XL 2016 VBA - copie des valeurs d'un tab avec redimentionnement

[faenor86]

Bonjour,

Petit problème de débutant VBA :
J'ai 3 cellules contenues dans une feuille F1, je chercher à les copier en passant par un tableau, puis à les coller dans une feuille F2.

J'ai déjà fait de nombreux test avec objets ou sans objets définis mais pas moyen de réaliser ce satané copier/coller....
ci-dessous mon code sans objet :

Sub copiercollercellules2()
 
    Dim A, B, C As Long
    Dim Vartab As Variant
  
  
    A = Sheets("F1").Range("A4")
    B = Sheets("F1").Range("C4")
    C = Sheets("F1").Range("C7")
  
    Vartab = Array(A, B, C)
  
    'on cherche à copier les cases A4-C4-C7 présent dans l'onglet F1 vers l'onglet F2. Les données seront coller à partir de A2 sur forme d'une seule ligne
  
  
    Sheets("F2").Select
    Range("A2").Resize(1, UBound(Vartab.Value) + 1) = Vartab

End Sub

Si quelqu'un a une solution à partir de cette méthode, je lui en serais très reconnaissant !
Merci
Très cordialement

 

[bof]

bonjour,
Essaie :

Sub copiercollercellules2()
Dim A, B, C As Long
Dim Vartab As Variant
A = Sheets("F1").Range("A4")
B = Sheets("F1").Range("C4")
C = Sheets("F1").Range("C7")
Vartab = Array(A, B, C)
With Sheets("F2")
.Select
.Range("A2").Resize(1, UBound(Vartab) + 1) = Vartab
End With
End Sub

A+

 

[faenor86]

hello ! ça marche 🙂

merci !

 

[faenor86]

Rebonjour !

Il s'agissait de la première étape de mon projet : copier des cellules désordonnées vers un autre onglet en les mettant sur une ligne.
L'étape suivante est qu'à chaque exécution de la Macro, j'incrémente un ID et que les transferts (ou sauvegardes) se fassent les un en dessous des autres comme sur l'exemple qui suit :

J'ai actuellement le code suivant :

Sub copiercollercellules2()
 
    Dim A, B, C As Long
    Dim D As Date
    Dim NbLignes As Integer
    Dim NumLigne As Integer
    Dim Vartab As Variant
  
  
    A = Sheets("F1").Range("A4")
    B = Sheets("F1").Range("C4")
    C = Sheets("F1").Range("C7")
    D = Now
  
    'on cherche à copier les cases A1-C3-C6 présent dans l'onglet F1 vers l'onglet F2. Les données seront collées à partir de A2 sur forme d'une seule ligne
    'intégration d'un ID et de la date d'excécution de la macro
  
    Sheets("F2").Select
    NbLignes = Selection.Rows.Count
    Vartab = Array(NbLignes, D, A, B, C)
    NumLigne = NbLignes + 1
    Range("A" & NumLigne).Resize(1, UBound(Vartab) + 1) = Vartab
  
    NumLigne = NumLigne + 1

End Sub

En réalité le code ne copie qu'une occurence... mais je n'ai pas d'erreur
Quelqu'un verrait-il ce qui coince ?

Merci pour votre patience

 

[laetitia90]

bonjour tous 🙂🙂
essai comme cela

Sub es()
Dim t(), x As Long
With Sheets("F1")
   x = Sheets("F2").Cells(Rows.Count, 2).End(3)(2).Row
   t = Array(x - 1, Now, .[A4], .[C4], .[C7])
  Sheets("F2").Range("A" & x).Resize(, UBound(t) + 1) = t
End With
End Sub

 

[faenor86]

Hello !
ça fonctionne nickel 🙂
Je suis impressionné qu'un aussi petit code réponde à mes attentes 😉

En résumé et pour bien comprendre :
- tu crée un tableau dynamique et une variable de comptage
- tu sélectionnes l'objet F1
- tu comptes le nb de ligne dans le feuille F2
- tu stockes les valeurs de nos cellules dans un tableau
- tu redimensionnes le tableau et déverses le contenu sur F2 dont le point de départ est variable

une ligne m'intéresse tout particulièrement : x = Sheets("F2").Cells(Rows.Count, 2).End(3)(2).Row
que signifie après .END, les (3) et (2) ?

Merci et bon weekend

 

[Staple1600]

Bonsoir le fil, le forum

Je me permets de répondre, leti étant AFK 😉
3: xlUp
2:Offset(1)

En guise d'illustration

Sub PetitTest()
Dim L&, A$
Cells.Clear
'petit clin d'oeil pour générer des donées de test
ActiveSheet.Cells(VBA.Round(Rnd * 1600, 0), 1).Value = Chr(149)
'écriture "allégée"
L = ActiveSheet.Cells(Rows.Count, 1).End(3)(2).Row: A = ActiveSheet.Cells(Rows.Count, 1).End(3)(2).Address(0, 0)
MsgBox "Ligne: " & L & vbCrLf & "Cellule: " & A
Application.Goto ActiveSheet.Cells(Rows.Count, 1).End(3), True
'écriture classique
MsgBox ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).Address(0, 0)
End Sub

 

[laetitia90]

re tous🙂🙂🙂
l'ami Jean Marie a bien "bossé"😉 bien son petit exemple😉

beaucoup de methode pour ecrire cela
exemple en simplifiant la restitution dans ton cas variable t paranthése pas obligatoire idem dans premier post

Sub a()
Dim t, x As Long
With Sheets("F1")
   x = Sheets("F2").Cells(Rows.Count, 2).End(3)(2).Row
   t = Array(x - 1, Now, .[A4], .[C4], .[C7])
  Sheets("F2").Range("A" & x).Resize(, 5) = t
End With
End Sub

ou encore

Sub b() 'sans declarer un tablo
Dim x As Long
With Sheets("F1")
   x = Sheets("F2").Cells(Rows.Count, 2).End(3)(2).Row
  Sheets("F2").Range("A" & x).Resize(, 5) = Array(x - 1, Now, .[A4], .[C4], .[C7])
End With
End Sub

on peut enlever le(2) traiter x directement

Sub c()
Dim x As Long
With Sheets("F1")
   x = Sheets("F2").Cells(Rows.Count, 2).End(3).Row
  Sheets("F2").Range("A" & x + 1).Resize(, 5) = Array(x, Now, .[A4], .[C4], .[C7])
End With
End Sub

avec cells
' Sheets("F2").Cells(x + 1, 1).Resize(, 5) = Array(x, Now, .[A4], .[C4], .[C7])

ect....

 

[faenor86]

Bonjour à tous,

merci pour votre retour détaillé et l'exposé de vos solutions alternatives !
Belle journée à vous

 

[faenor86]

Rebonjour !

Les Weekend pluvieux sont propices au développement VBA....

Je souhaiterai complexifier la macro en récupérant des dossiers de divers feuilles de calcul.
Pour mémoire actuellement le code copie des valeurs de l'onglet F1 vers le F2. Est-il possible de récupérer les valeurs des cellules éparses situées dans F1 et F0 (nouvel onglet) pour les mettre dans F2 ?

merci !