M. Mustafa BOLAT

Excel, VBA, Python, SQL, Power BI Eğitmeni | Öğretim Görevlisi | Yazılım Geliştirici

Kurumsal eğitim talepleriniz için bilgi@bymmb.com adresinden mail ile ulaşabilirsiniz.

Kitabımı aşağıdaki linki (D&R) kullanarak temin edebilirsiniz.
Excel’in Kök Hücresi D&R

E-Kitap olarak almak için aşağıdaki linki kullanabilirsinmiz.
E-KİTAP

Udemy’de yer alan tüm online eğitimlerime aşağıdaki linkleri kullanarak en düşük fiyattan katılabilirsiniz.

Tüm kurslarıma, katıldıktan sonra ömür boyu 7/24 erişebilir, istediğiniz zaman başlayabilir ve istediğiniz zaman tekrar izleyebilirsiniz. Kurs bitiminde sertifika da verilmektedir.

Sub sekmeleri_al()
Dim mmb As Worksheet
Dim yol As String
Dim bymmb As String
Dim mustafabolat As Integer

bymmb = ThisWorkbook.FullName
mustafabolat = InStrRev(bymmb, "\")
yol = Left(bymmb, mustafabolat)

For Each mmb In ThisWorkbook.Worksheets
mmb.Copy
Application.ActiveWorkbook.SaveAs Filename:=yol & mmb.Name & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.ActiveWorkbook.Close False
Next mmb
End Sub
Sub merge_bymmb()
    Dim bymmb As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim startRow As Long
    Dim currentValue As String
    Dim columnNumber As Integer
    Dim columnLetter As String
    
    Set bymmb = ThisWorkbook.ActiveSheet
    
    columnLetter = InputBox("Lütfen merge işlemi yapmak istediğiniz sütun harfini girin (A, B, C, ...):")
    columnNumber = Columns(columnLetter & ":" & columnLetter).Column
    
    lastRow = bymmb.Cells(bymmb.Rows.Count, columnNumber).End(xlUp).Row
    
    startRow = 2
    currentValue = bymmb.Cells(startRow, columnNumber).Value

    Application.DisplayAlerts = False
    
    For i = startRow + 1 To lastRow + 1
        If bymmb.Cells(i, columnNumber).Value <> currentValue Then

            If i - startRow > 1 Then
                bymmb.Range(bymmb.Cells(startRow, columnNumber), bymmb.Cells(i - 1, columnNumber)).merge
                bymmb.Cells(startRow, columnNumber).HorizontalAlignment = xlCenter
                bymmb.Cells(startRow, columnNumber).VerticalAlignment = xlCenter
            End If
            startRow = i
            currentValue = bymmb.Cells(i, columnNumber).Value
        End If
    Next i
    Application.DisplayAlerts = True
End Sub