Fusion cellule derniere ligne non vide

**mariet18** · 10/09/2018, 14h17

Bonjour,

Ma macro rajoute une ligne à un fichier en la completant. Mais j´aimerai qu´elle fusionne deux cellules (colonne B et C) de cette ligne, donc de la derniere ligne non vide

Auriez vous une idée ?

Merci

**BENNASR** · 10/09/2018, 14h32

voir cette discussion pour inspirer une réponse

https://www.developpez.net/forums/d5...-cellules-vba/

**a_diard** · 10/09/2018, 14h32

Bonjour

Pour répondre à ta question ce serait bien d'indiquer ton code

Dans la mesure out tu ajoute une ligne

fusionner les colonne B&C pour la nouvelle ligne doit être relativement facile

avec ligne = numéro de la ligne à traiter.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(Cells(ligne, 2), Cells(ligne, 3)).MergeCells = True

**mariet18** · 10/09/2018, 15h16

Envoyé par a_diard

Bonjour

Pour répondre à ta question ce serait bien d'indiquer ton code

Dans la mesure out tu ajoute une ligne

fusionner les colonne B&C pour la nouvelle ligne doit être relativement facile

avec ligne = numéro de la ligne à traiter.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(Cells(ligne, 2), Cells(ligne, 3)).MergeCells = True

Merci pour ta reponse, mais il m´affiche une erreur lors de la compilation : object defined error ..

Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Sub UPDATE()
'
' UPDATE Macro
' Update the files named : " 24_Teilelebenslauf_.........xlsx " stored in a same folder.  The update is done only for the file where the part number is the same.`
' Precaution to do :
' The date format have to be : 17.04.2018 and not : 18/07/2018
' Be careful with the part number format and espacially with the space between the numbers.
' Keyboard Shortcut: Ctrl+Shift+U
 
Dim BDD As FileDialog 'declare new variable BDD (Folder dialog box)
Dim CA As String 'declare new variable CA (Folder path)
Dim CD As Workbook 'declare new variable CD (Source File)
Dim OD As Worksheet 'declare new variable OD (Source Sheet)
Dim FS As String 'declare new variable FS (Destination File)
Dim CS As Workbook 'declare new variable CS (Destination file)
Dim OS As Worksheet 'declare new variable OS (Destination Sheet)
Dim DEST As Range 'declare new variable DEST (DESTination cell)
Dim Plageborder As String
 
 
'to define the dialog box BDD (defined source folder)
Set BDD = Application.FileDialog(msoFileDialogFolderPicker)
With BDD
    .AllowMultiSelect = False 'only one selection allowed
    .Show 'display BDD
    If .SelectedItems.Count = 0 Then Exit Sub 'if you click on the command CANCEL, get of the procedure
    CA = .SelectedItems(1) & "\"
End With 'End of the dialog box BDD
 
Set CD = ThisWorkbook 'define the source folder CD
Set OD = CD.Sheets("BPF - SPF") 'define the source sheet OD (to adapt with the sheet name/sheet number)
FS = Dir(CA & "*.xlsx") 'define the first destination excel file to modify with CA as folder path
Do While FS <> "" ' execute while one source folder existing
    Workbooks.Open CA & FS 'open the destination file
    Set CS = ActiveWorkbook 'define the destination file CS
    Set OS = CS.Worksheets(1) 'define the destination sheet OS (to adapt with the sheet name/sheet number)
 
    '*******************************************************************************************
 
 
    If OS.Range("C5").Value = OD.Range("BJ11").Value Then  'if the part number is the same, modification ...
 
 
        Set DEST = OS.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'define destination cells DEST (first blank cells in the column A)
        DEST.Activate
        ActiveCell.FormulaR1C1 = "=R[-1]C+1"
        Set DEST = DEST.Offset(0, 1)
 
        MsgBox (CS.Name & "  is updated")
 
        CD.Sheets("BPF - SPF").Activate
        OD.Range("AU4").Copy
        DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Set DEST = DEST.Offset(0, 1)
        OD.Range("N39").Copy
        DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        DEST.Offset(0, -1) = DEST.Offset(0, -1) & Chr(10) & DEST
        DEST = ""
 
        Set DEST = DEST.Offset(0, 1)
 
        OD.Range("P12").Copy
        DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Set DEST = DEST.Offset(0, 1)
        OD.Range("P13").Copy
        DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        DEST.Offset(0, -1) = DEST.Offset(0, -1) & Chr(10) & DEST
        DEST = ""
 
        OD.Range("BJ12").Copy
        DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Set DEST = DEST.Offset(0, 1)
        OD.Range("BJ13").Copy
        DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
 
        Set DEST = DEST.Offset(0, 1)
        OD.Range("BJ15").Copy
        DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Set DEST = DEST.Offset(0, 1)
        OD.Range("BL15").Copy
        DEST.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
 
        DEST.Offset(0, -3) = DEST.Offset(0, -3) & Chr(10) & DEST.Offset(0, -2) & Chr(10) & DEST.Offset(0, -1) & DEST
        DEST = ""
        DEST.Offset(0, -2) = ""
        DEST.Offset(0, -1) = ""
 
 
        OS.Range(Cells(ligne, 2), Cells(ligne, 3)).MergeCells = True
 
        Application.ScreenUpdating = False
 
 
        Dim cellule As Range
        For Each cellule In OS.Range("A9:H30")
        If cellule <> "" Then
        cellule.Borders.Weight = xlThin
        End If
        Next
 
    CS.Save
    CS.Close
 
    Else: CS.Close 'if the part number are not the same, close the file
    End If
 
 
    'call MaMacro
 
FS = Dir 'define the next destination file
 
Loop
 
End Sub

**a_diard** · 10/09/2018, 16h53

Rebonjour

il faut que tu charge dans la variable ligne

le numéro de la ligne à traiter

Fusion cellule derniere ligne non vide

Macros et VBA Excel

Discussions similaires

Partager

Partager