Macro copier-coller deplacer sur la droite si cellule pleine Résolu

Question

Je recherche une macro pour copier la cellule A1 de la feuille 1  d'un classeur "macro" et la coller sur la feuille "résultat" en A1 du classeur "graph". Mais si celle-ci n'est pas vide décaler vers la droite etc.
Fagots

Le Pingou · Answer

Bonjour,
Voici un exemple de procédure à adapter selon vos classeurs :
Sub Importer_plage_A1()
Dim objcible As Workbook, objsource As Workbook
Dim cel As Variant, c As Long
Set objsource = Workbooks(nomclassuersource.xlsm)
Set objcible = Workbooks(nomclassuercible.xlsx)
Application.ScreenUpdating = False
nucol = objcible.Sheets(1).Cells(1,Rows(1).Cells.Count).End(xlUp).Column objsource.Sheets(1).Range("A1 ").copy Destination := objcible.Sheets(1).Cells(1,nucol)
Set objcible = Nothing
Set objsource = Nothing
Application.ScreenUpdating = True
End Sub

Le Pingou · Answer

Bonjour ,
Ce doit-être 2 lignes de code :
nucol = objcible.Sheets(1).Cells(1,Rows(1).Cells.Count).End(xlUp).Column

objsource.Sheets(1).Range("A1 ").copy Destination := objcible.Sheets(1).Cells(1,nucol)

Le Pingou · Answer

Bonjour,
Une petite erreur de code m'a échappée, la ligne correcte pour la variable [nucol]:
nucol = objcible.Sheets(1).Cells(1, Rows(1).Cells.Count).End(xlToLeft).Column + 1

Le Pingou · Answer

Bonjour,
C'est normal le nom du classeur doit être écrit entre guillemet (je pensais que vous le saviez, désolé):
Set objsource = Workbooks("fichier2.xlsm")
Note : il va de soi que les 2 classeurs sont ouverts.
 
 
Salutations.
Le Pingou

fagots · Answer

Ok merci tous cela fonctionne parfaitement.
Salutations

Le Pingou · Answer

Merci, de rien.

fagots · Answer

Bonjour,
Derniere petite question dans la macro donnée, comment faire pour coller uniquement la valeur de la cellule A1? 
merci de votre aide

Le Pingou · Answer

Bonjour,
Remplacer cette ligne  
objsource.Sheets(1).Range("A1 ").copy Destination := objcible.Sheets(1).Cells(1,nucol)Par ces 2 lignes :
objsource.Sheets(1).Range("A1 ").Copy 
objcible.Sheets(1).Cells(1,nucol).PasteSpecial xlPasteValues

Le Pingou · Answer

Bonjour,
Dans ce cas il faut modifier la manière de travaillé de la procédure.
Comme j'ai l'impression qu'après chaque réponse il y a une nouvelle question, alors je vais attendre un petit peu pour la réponse... !

Le Pingou · Answer

Bonjour,
Une question, comment je fais pour savoir quelle cellule de la ligne 1 je dois copier/coller sur l'autre classeur ?
Si vous dite la dernière, alors comment savoir si cela n'a pas déjà été réalisé ?

foo · Answer

bonjour
Tien pour jouer avec une boucle

Sub testColonne()
Feuil1.Select
   For L = 2 To 29
      Range("A" & L).Copy
      Nucol = Feuil2.Cells(L, Columns.Count).End(xlToLeft).Column + 1
      Feuil2.Cells(L, Nucol).PasteSpecial xlPasteValues
   Next
End Sub

A+
Maurice

foo · Answer

Bonjour

une petite modife

Sub testColonne()
Feuil1.Select
   For L = 2 To 29
      Col = Cells(L, Columns.Count).End(xlToLeft).Column
      Cells(L, Col).Copy
      Nucol = Feuil2.Cells(L, Columns.Count).End(xlToLeft).Column + 1
      Feuil2.Cells(L, Nucol).PasteSpecial xlPasteValues
   Next
End Sub

A+
Maurice

foo · Answer

re
donne au moin un modele car ca marche chez moi

A+

Maurice

Le Pingou · Answer

Bonjour fagots,
Merci pour l'explication (message 17 de 09 :.53)
Je regarde le problème en fin de journée et la réponse suivra.

Le Pingou · Answer

Bonjour fagots,
Question intermédiaire : est-ce que les valeurs de la ligne 1 du fichier source sont identiques à la ligne 1 du fichier source ... ?
Note : pourquoi pas de titre de colonne en ligne 1 et le début des données en ligne 2 ?

Le Pingou · Answer

Bonjour,
Merci c'est parfait.
Un dernier petit détail, il y-a-t-il des formules dans la ligne 1 du fichier source et si oui sur combien de colonnes?
 
Salutations.
Le Pingou

Le Pingou · Answer

Bonjour,
Ma proposition, copie et colle le(s) valeur(s) vers le fichier cible.
Merci d'adapter les noms selon vos besoins.
La procédure :
Sub Importer_valeur_cellule()
Dim objcible As Workbook, objsource As Workbook
Dim c As interger, nbvaci As Integer, nbvaso As Integer
Set objsource = Workbooks("Classeur11.xlsm")
Set objcible = Workbooks("classeur12.xlsx")
Application.ScreenUpdating = False
' contrôler si nouvelle valeur sur classeur source
nbvaso = WorksheetFunction.CountA(objsource.Sheets("Feuil1").Rows(1))
nbvaci = WorksheetFunction.CountA(objcible.Sheets("Feuil1").Rows(1))
If nbvaci < nbvaso Then
    For c = 1 To (nbvaso - nbvaci)
        objsource.Sheets("Feuil1").Cells(1, nbvaci + c).Copy
        objcible.Sheets("Feuil1").Cells(1, nbvaci + c).PasteSpecial xlPasteValues
    Next c
End If
Set objcible = Nothing
Set objsource = Nothing
Application.ScreenUpdating = True
End Sub

Le Pingou · Answer

Bonjour,
C'est étonnant, j'ai testé et cela fonctionne parfaitement.
Pouvez-vous me mettre une copie de la macro telle que vous l'utilisez... !

Le Pingou · Answer

Bonjour,
De cette manière je pense que ce sera bon:
Sub Importer_valeur_cellule()
Dim objcible As Workbook, objsource As Workbook
Dim shci As Object, shso As Object
Dim c As Integer, nbvaci As Integer, nbvaso As Integer
Set objsource = Workbooks("fichier1.xlsx")
Set objcible = Workbooks("fichier2.xlsm")
Set shso = objsource.Sheets("Feuil1")
Set shci = objcible.Sheets("Feuil2")

Application.ScreenUpdating = False
' contrôler si nouvelle valeur sur classeur source
nbvaso = WorksheetFunction.CountA(shso.Rows(1))
nbvaci = WorksheetFunction.CountA(shci.Rows(1))
If nbvaci < nbvaso Then
 For c = 1 To (nbvaso - nbvaci)
 shso.Cells(1, nbvaci + c).Copy
 shsi.Cells(1, nbvaci + c).PasteSpecial xlPasteValues
 Next c
End If
Set objcible = Nothing: Set shci = Nothing
Set objsource = Nothing: Set shso = Nothing
Application.ScreenUpdating = True
End Sub

Le Pingou · Answer

Bonjour,
Pouvez-vous me mettre :
Fichier source c'est celui ou vous avez les nouvelles valeurs pour votre classeur cible
-	Nom du classeur
-	Nom de la feuille
-	Numéro de la ligne pour les données
Idem pour le classeur cible qui est celui ou vous aurez la procédure.

Le Pingou · Answer

Bonjour,
Le numéro de la ligne des données n'était pas correct, procédure corrigée :
Sub Importer_valeur_cellule()
Dim objcible As Workbook, objsource As Workbook
Dim shci As Object, shso As Object
Dim c As Integer, nbvaci As Integer, nbvaso As Integer
Set objsource = Workbooks("fichier1.xlsx")
Set objcible = Workbooks("fichier2.xlsm")
Set shso = objsource.Sheets("Feuil1")
Set shci = objcible.Sheets("Feuil2")
Application.ScreenUpdating = False
' contrôler si nouvelle valeur sur classeur source
nbvaso = WorksheetFunction.CountA(shso.Rows(3))
nbvaci = WorksheetFunction.CountA(shci.Rows(3))
If nbvaci < nbvaso Then
 For c = 1 To (nbvaso - nbvaci)
 shso.Cells(3, nbvaci + c).Copy
 shsi.Cells(3, nbvaci + c).PasteSpecial xlPasteValues
 Next c
End If
Set objcible = Nothing: Set shci = Nothing
Set objsource = Nothing: Set shso = Nothing
Application.ScreenUpdating = True
End Sub

Le Pingou · Answer

Bonjour,
L'écriture est correcte, pas de point entre [PasteSpecial xlPasteValues].
Je pense que le problème est ailleurs, ce serait plus simple de trouver l'erreur si vous pouviez  me mettre les 2 classeurs à dispositions. Si oui, les compresser dans un dossier ZIP ou RAR et mettre ce dernier sur https://www.cjoint.com/  et poster le lien.

Le Pingou · Answer

Bonjour,
Une petite erreur d'écriture, remplacer [shsi....] par [shci...]... !
Au passage je constate que vous avez plusieurs lignes dans votre tableau...... est-ce que vous devez aussi les mettre à jour.... ?
 
 
Salutations.
Le Pingou

Le Pingou · Answer

Bonjour,
Vos fichiers avec un petit complément d'affichage ... : https://www.cjoint.com/?3HwlCAAMP2A

Le Pingou · Answer

Bonjour,
Eh bien, la procédure ne traite que la ligne 3 selon votre demande.
Concernant mon dernier message avec : Vos fichiers avec un petit complément d'affichage il s'agit uniquement d'une mise en forme conditionnelle avec un fond rouge pour pourcentage plus petit ou égale à 94%.
La question que je me pose c'est : est-ce que cela fonctionne pour la ligne 3 .... ?

Le Pingou · Answer

Bonjour,
Merci alors c'est parfait puisque cela répond à votre demande de départ.
En ce qui concerne le traitement de toutes les lignes, la procédure n'est pas la même et de plus il est nécessaire de connaitre la structure des 2 fichiers.
Donc je ne peux pas en faire plus, désolé.

Le Pingou · Answer

Bonjour,
Pour vous mettre sur la piste, il faut utiliser une boucle sur les lignes de la colonne [A :A] et en plus contrôler l'équivalence entre les 2 fichiers

Macro copier-coller deplacer sur la droite si cellule pleine

27 réponses

Discussions similaires

Newsletters