Structure: Worksheet.Range(
"FirstCell:LastCell"
).Merge
For exam:
Code:
Sub MergeC()i1 = Sheet2.Range("B1000").End(xlUp).Row
k = 2
For i = 3 To i1
If i = i1 Then
Sheet2.Range("A" & k & ":A" & i1).Merge
ElseIf Sheet2.Range("A" & i) <> "" Then
Sheet2.Range("A" & k & ":A" & (i - 1)).Merge
k = i
End If
Next
End Sub
Exam2: Merge cells same text automatically, over 9000 lines in 10 seconds
Code:
Sub MergeC()
Dim i As Long
i1 = Sheet1.Range("A10000").End(xlUp).Row
k = 2
m = 2
For i = 3 To i1
If Sheet1.Range("A" & k) = Sheet1.Range("A" & i) Then
Sheet1.Range("A" & i) = ""
Else
Sheet1.Range("A" & k & ":A" & (i - 1)).Merge
k = i
End If
If Sheet1.Range("B" & m) = Sheet1.Range("B" & i) Then
Sheet1.Range("B" & i) = ""
Else
Sheet1.Range("B" & m & ":B" & (i - 1)).Merge
m = i
End If
Next
End Sub