MyNameIs
MyNameIs

Reputation: 1

VBA Merge fixed number of columns on sequential arrows

I am trying to write a Macro that will merge, on a fixed range of data, each cells of one row. For each row of my range I want cells from column b to G to be merged. The only cells that contain data are the left one (Ci). I have tried multiple syntax but it all lead to nowhere. I don't understand if I could activate my sheet or how I should write my variable to get the .merge method to work... As said, I tried a different number of syntax but I always get the

error 1004, application-defined or object defined error.

This is my latest version.

Sub Merge1()

Dim sourcecell As Range
Dim firstcell As Range
Dim lastcell As Range
Dim i As Integer
Dim lastrow As Integer

Sheets("Tabelle1").Activate
Set sourcecell = Range("B2") `cell top left corner
Set firstcell = sourcecell.Offset(i, 2)
Set lastcell = sourcecell.Offset(i, 5)
lastrow = Range("B2").End(xlUp).Row

For i = 14 To lastrow
Range(firstcell, lastcell).Select
    With Selection
        .HorizontalAlignment = xlUp
        .VerticalAlignment = xlLeft
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge (arrow)
Next i
End Sub

Upvotes: 0

Views: 53

Answers (3)

MyNameIs
MyNameIs

Reputation: 1

Based on this answer, I made the following solution:

Sub Merge()
    Dim ws As Worksheet
    Dim rng As Range
    Dim i As Long
    Dim lastRow As Long

    Set ws = Sheets("Tabelle1")
    lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 14 To lastRow
        Set rng = Range(ws.Cells(i, 2), ws.Cells(i, 7))
        rng.Merge
    Next i
End Sub

Upvotes: 0

Mika Oukka
Mika Oukka

Reputation: 216

This could work. Check how the lastrow check is different. You check it from the bottom of the table in column B. Also your loop starts from 14 for some reason and if you set .merge to false it will not merge any cells. I hope this helps.

Sub Merge()
    Dim ws As Worksheet
    Dim rng As Range
    Dim i As Long
    Dim lastRow As Long

    Set ws = Sheets("Tabelle1")
    lastRow = ws.Cells(Rows.Count, 2).End(xlUp).Row

    For i = 2 To lastRow
        Set rng = Range(ws.Cells(i, 2), ws.Cells(i, 7))
        rng.MergeCells = True
    Next i
End Sub

Upvotes: 0

cybernetic.nomad
cybernetic.nomad

Reputation: 6418

You need to set the values of firstcell and lastcell inside the loop

Try the following:

Dim sourcecell As Range
Dim firstcell As Range
Dim lastcell As Range
Dim i As Long
Dim lastrow As Long

Set sourcecell = Range("B2")
lastrow = Range("B2").End(xlUp).Row

For i = 14 To lastrow
    Set firstcell = sourcecell.Offset(i, 2)
    Set lastcell = sourcecell.Offset(i, 5)
    With Range(firstcell, lastcell)
        .MergeCells = True
    End With
Next i

Upvotes: 2

Related Questions