Macro coller une sélection à la suite de la dernière colonne remplie

VBA
1

Bonjour à tous,

J’aimerais créer une macro qui me permettrait d’aller copier une sélection de cellules dans un fichier et de le coller dans un autre, puis d’aller copier une sélection de cellules dans un autre fichier et de le coller dans le fichier mais à la suite de ce qui a été collé auparavant.
A savoir que les fichiers dans lesquels je veux copier la sélection de cellules sont tous identiques ou du moins ont la même forme donc la plage de cellules sera toujours la même.

J’ai réussi à réaliser la macro et elle fonctionne jusqu’à l’étape de coller à la suite de ce qui a été collé auparavant.

Auriez-vous une solution pour m’aider ?

Je vous mets ci-dessous ma macro en l’état :

Sub consolidations()

Dim wbRecap As Workbook
Dim wsRecap As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim DernLign As Integer
Dim vFichiers As Variant
Dim i As Integer, k As Integer
Dim rgRecap As Range
Dim Destination As Variant
Dim der_col As Variant
Dim col_coller As Variant

Set wbRecap = ThisWorkbook
Set wsRecap = wbRecap.Sheets(« 2.14 »)

’ — Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir
vFichiers = Selectionner_Fichiers(« Selectionner les fichiers à compiler »)

'Chercher un fichier
If Not IsArray(vFichiers) Then
Debug.Print « Aucun fichier sélectionné. »
MsgBox « Erreur! Aucun/Mauvais fichier sélectionné. »
Exit Sub
End If
On Error Resume Next

Application.ScreenUpdating = False

For k = 1 To UBound(vFichiers)
Application.StatusBar = « >> Lecture du fichier # » & k & « / » & UBound(vFichiers)

Set wbSource = Workbooks.Open(vFichiers(k))
Set wsSource = wbSource.Sheets(« 2.14 »)

der_col = wsSource.Cells(Rows.Count, 1).End(xlUp).Row
rgRecap = Time

'With wsSource(« Sheet1 »)
With wsSource

For i = 1 To 100
Destination = wsRecap.Cells(i, 10)
col_coller = wsSource.Cells(Rows.Count, 1).End(xlUp).Row + 10
If Destination = «  » Then
wsSource.Range(wsSource.Cells(i, 1), wsSource.Cells(i, 10)).Copy wsRecap.Cells(i, 1)
ElseIf Not Destination = «  » Then
wsSource.Range(wsSource.Cells(i, 1), wsSource.Cells(i, 10)).Copy wsRecap.Cells(i, col_coller)
End If

Next

End With

wbSource.Close
Set wbSource = Nothing

Next k

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

Je vous remercie !

2

Bonjour
Sans fichiers très difficiles mais déjà une suggestion à essayer

A la place de cette ligne de code :

wsSource.Range(wsSource.Cells(i, 1), wsSource.Cells(i, 10)).Copy wsRecap.Cells(i, col_coller)

Mets celle-ci :

wsSource.Range(wsSource.Cells(i, 1), wsSource.Cells(i, 10)).Copy wsRecap.Cells(col_coller,1)

Au regarde de cette ligne de code en amont :

col_coller = wsSource.Cells(Rows.Count, 1).End(xlUp).Row + 10

C est ce qui me semble plus logique

Mais encore une fois sans la matière première pas simple de se faire la bonne opinion

A toi de tester et dire

3

Bonjour,

Merci pour votre réponse.

Malheureusement je ne peux pas vous transmettre mes fichiers car ils sont confidentiels mais je peux vous transmettre un classeur test sur lequel je teste mes macros.

Sur ce fichier, mon but est de copier les données de la sélection A1:C3 de la feuille 1 et de les coller en A1:C3 de la feuille 2 puis de copier encore une fois les mêmes données de la feuille 1 et de les coller en D1:F3 de la feuille 2 puis de même en G1:I3 etc…

Ma macro existe déjà sur le classeur dans le cas ou vous souhaitez l’étudier.
Nb : ce n’est pas la même que celle que je vous ai transmise dans le message précédent mais c’est cette partie de la macro qui me pose problème.

Classeur1.xlsm (24,6 Ko)

4

D’ailleurs j’ai testé votre proposition mais cela colle ma sélection en dessous alors que je cherche à la coller à la suite mais vers la droite. J’ai réamménagé ma macro pour que cela corresponde plus à mon attente.

5

'D’ailleurs j’ai testé votre proposition mais cela colle ma sélection en dessous alors que je cherche à la coller à la suite mais vers la droite. J’ai réamménagé ma macro pour que cela corresponde plus à mon attente."

Alors c’est la ligne de code en amont qui ne va pas :

col_coller = wsSource.Cells(Rows.Count, 1).End(xlUp).Row + 10

Cette instruction détermine une ligne non pas une colonne :

.Row + 10

Row c’est ligne

Pour la colonne il faut mettre comme ceci :

col_coller = wsSource.Cells(1, Columns.Count).End(xlToLeft).Column + 10

Et donc maintenir cette ligne de code qui suit :

wsSource.Range(wsSource.Cells(i, 1), wsSource.Cells(i, 10)).Copy wsRecap.Cells(i, col_coller)

A essayer

6

Voila la macro que j’obtiens avec vos conseils. Alors cela me permet bien de coller à la suite en revanche lorsque que je l’exécute, ma sélection n’est pas coller comme il le faut. En effet seule la première ligne de ma sélection (A1:C1) se colle directement à la suite et le reste de ma sélection (A2:C3) se colle plus loin (cf image).

image
image844×208 3.81 KB

Ce que je souhaite c’est que toute la sélection soit collée directement à la suite. Il doit me manquer une condition ou simplement ma destination n’est pas bonne je ne sais pas…

Voici ma macro :
Dim ws_1 As Worksheet
Dim ws_2 As Worksheet
Dim der_lig As Variant
Dim dercol As Variant
Dim col_coller As Variant
Dim destination As Variant

Set ws_1 = Worksheets(1)
Set ws_2 = Worksheets(2)

der_lig = ws_1.Cells(Rows.Count, 1).End(xlUp).Row
dercol = ws_2.Cells(1, Cells.Columns.Count).End(xlToLeft).Column

For i = 1 To der_lig
destination = ws_2.Cells(i, dercol)
col_coller = ws_2.Cells(1, Cells.Columns.Count).End(xlToLeft).Column + 1
If destination = «  » Then
ws_1.Range(ws_1.Cells(i, 1), ws_1.Cells(i, 3)).Copy ws_2.Cells(i, dercol)
ElseIf Not destination = «  » Then
ws_1.Range(ws_1.Cells(i, 1), ws_1.Cells(i, 3)).Copy ws_2.Cells(i, col_coller)
End If

Next

End Sub

et voici le classeur si vous voulez jeter un oeil dessus :
Classeur1.xlsm (24,6 Ko)

7

Bonjour,
Teste comme ceci

Sub copier_coller()

  Dim ws_1 As Worksheet
  Dim ws_2 As Worksheet
  Dim der_lig As Variant
  Dim dercol As Variant
  Dim col_coller As Variant
  Dim destination As Variant
  
  Set ws_1 = Worksheets(1)
  Set ws_2 = Worksheets(2)
  
  der_lig = ws_1.Cells(Rows.Count, 1).End(xlUp).Row
  dercol = ws_2.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
  destination = ws_2.Cells(3, dercol)
  col_coller = ws_2.Cells(1, Cells.Columns.Count).End(xlToLeft).Column + 1
    For i = 1 To der_lig
      If destination = "" Then
        ws_1.Range(ws_1.Cells(i, 1), ws_1.Cells(i, 3)).Copy ws_2.Cells(i, dercol)
      ElseIf Not destination = "" Then
        ws_1.Range(ws_1.Cells(i, 1), ws_1.Cells(i, 10)).Copy ws_2.Cells(i, col_coller)
      End If
    Next i
End Sub
8

Ca y est ça fonctionne parfaitement je vous remercie pour votre aide précieuse !!

9

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.