Collage de cellules non vides dans une plage ciblee

FlW95

XLDnaute Nouveau
Bonjour à tous,
Je cherche l'aide à propos de ce souci : j'aimerai récupérer les donnés non vides d'une plage de départ située dans un 1er classeur pour les coller dans une plage précise d'arrivée d'un deuxième classeur . Je pense ne pas en être loin, j'arrive à récupérer les valeurs mais pas moyen de les mettre là où je voudrais. Voici mon code actuellement :
Windows("fichier1. Xlsm"). Activate
Sheets("feuil1").Select

For each Cel in Worksheets("Feuil1"). Range("B20:B44").Cells

Cel. Copy sheets("Feuil2"). Range("D15:D" & Rows. Count). End(xlUp) .offset(1,0)

'Ma plage d'arrivée serait de D15 à D+
Next

De plus, quelle serait la syntaxe afin de changer de classeur pour le collage svp?
Merci par avance
 

job75

XLDnaute Barbatruc
Re,

Bon pour gagner du temps voyez les fichier joints et cette macro dans le fichier Source.xlsm :
Code:
Sub Transfert()
Dim chemin$, fichier$, feuille$, tablo, i&, n&, c As Range
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "Destination.xlsx" 'à adapter
feuille = "Feuil1" 'à adapter
If Dir(chemin & fichier) = "" Then MsgBox "'" & fichier & "' est introuvable...": Exit Sub
With [B20:B44]
    tablo = .Value 'matrice plus rapide
    For i = 1 To UBound(tablo)
        If tablo(i, 1) <> "" Then n = n + 1: tablo(n, 1) = tablo(i, 1)
    Next
End With
If n = 0 Then MsgBox "Aucune valeur à transférer...": Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
With Workbooks.Open(chemin & fichier).Sheets(feuille)
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    Set c = .Range("D" & .Rows.Count).End(xlUp)(2)
    If c.Row < 15 Then Set c = .[D15]
    c.Resize(n) = tablo
    .Activate
    .Parent.Save 'enregistrement (facultatif)
End With
End Sub
Les 2 fichiers sont à télécharger dans le même répertoire (le bureau).

A+
 

Pièces jointes

  • Source(1).xlsm
    24.3 KB · Affichages: 31
  • Destination.xlsx
    13.1 KB · Affichages: 26

FlW95

XLDnaute Nouveau
Merci pour le travail effectué,
Après l'avoir adapté, je réussi bien à ouvrir le fichier destination.
Cependant, les opérations de la macro concernant le fichier destination ne peuvent s'effectuer. Il apparait le bug "Décision ou non méthode n'appartient pas à cet objet"
Je pense que cela est dû au fait que le fichier destination est un fichier protégé, il ne possède d'ailleurs pas d'onglet apparent (onglet Feuil1 par exemple) avec certaines cellules protégées. J'ai d'ailleurs modifié le code sans l'indication de Sheets.(feuille) à la fin d l'instruction afin de pouvoir l'ouvrir correctement.
Il est toutefois bien possible de toucher à certaines cellules dont celles visées pour ce transfert de données.
Ce statut de fichier "protégé" peut il empêcher les actions possibles par une macro d'un fichier extérieur ?
Par ailleurs, ce fichier protégé de destination est un xls, cela ne joue pas sur l'exécution d'une macro extérieure contenue dans un fichier xlsm n'est-ce pas?
Cordialement
 

job75

XLDnaute Barbatruc
Re,

Il n'y a aucune protection dans le fichier de destination et son extension n'est pas .xls !

Aucun problème avec les fichiers joints, j'ai juste un peu modifié la macro :
Code:
Sub Transfert()
Dim chemin$, fichier$, feuille$, tablo, i&, n&
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = "classeur_arrivee.xlsm" 'à adapter
feuille = "Feuil1" 'à adapter
If Dir(chemin & fichier) = "" Then MsgBox "'" & fichier & "' est introuvable...": Exit Sub
tablo = [B20:C44] 'matrice plus rapide
For i = 1 To UBound(tablo)
    If tablo(i, 1) <> "" Then n = n + 1: tablo(n, 1) = tablo(i, 1): tablo(n, 2) = tablo(i, 2)
Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
With Workbooks.Open(chemin & fichier).Sheets(feuille)
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Range("D15:I" & .Rows.Count).Delete xlUp 'RAZ
    If n Then
        .[D15].Resize(n, 2) = tablo
        .[D15].Resize(n, 6).Borders.Weight = xlThin 'bordures sur6 colonnes
    End If
    .Activate
End With
End Sub
A+
 

Pièces jointes

  • Classeur_depart (1).xlsm
    69.7 KB · Affichages: 17
  • classeur_arrivee.xlsm
    21.5 KB · Affichages: 20
Dernière édition:

FlW95

XLDnaute Nouveau
Ok merci,
Etant donné que le fichier de destination originel est un document confidentiel et protégé, je l'ai adapté et mis dans un classeur classique xlsm non protégé.
Je vais essayer avec ce code et voir ce que ça donne avec le fichier original, merci
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof