VBA Macro that splits addresses in an excel column by formatting and puts them in separate workbooks

AddressSplitterByFormating.vba

Sub MoveAdr(lastCellOfInput As Range, firstRowOfOutput As Range, rowCount As Integer)
    Dim i As Integer
    For i = 0 To rowCount - 1
        firstRowOfOutput.Offset(0, i).Value = lastCellOfInput.Offset(i, 0).Value
    Next i
End Sub



Sub Macro1()
'
' Macro1 Macro
'


    Dim outputColIdx As Integer
    Dim outputRowIdx As Integer

    outputColIdx = 0
    outputRowIdx = 5
    
    Selection.Copy

    Dim offsetCounter As Integer
    Dim startRange As Range
    Dim singleColCounter As Integer

    singleColCounter = 0
    Set startRange = Worksheets(1).Range("A17")
    Set outputRange = Worksheets(2).Range("A1")

    Dim threeColAdrOffset As Integer
    threeColAdrOffset = 0

    Dim fourColAdrOffset As Integer
    fourColAdrOffset = 0

    Dim fiveColAdrOffset As Integer
    fiveColAdrOffset = 0
    Dim sixColAdrOffset As Integer
    sixColAdrOffset = 0

    Dim sevenColAdrOffset As Integer
    sevenColAdrOffset = 0


    Dim otherColAdrOffset As Integer
    otherColAdrOffset = 0


    Do

     If startRange.Offset(offsetCounter, 0).Characters(Start:=0, Length:=2).Font.FontStyle = "Bold" Then
            'MsgBox "start at" + startRange.Offset(offsetCounter, 0).Address


            If singleColCounter < 2 Or singleColCounter > 6 Then
                Set outputRange = Worksheets(7).Range("A1").Offset(otherColAdrOffset, 0)
                otherColAdrOffset = otherColAdrOffset + 1
            End If

            If singleColCounter = 3 Then
                Set outputRange = Worksheets(2).Range("A1").Offset(threeColAdrOffset, 0)
                threeColAdrOffset = threeColAdrOffset + 1
            End If

            If singleColCounter = 4 Then
                Set outputRange = Worksheets(3).Range("A1").Offset(fourColAdrOffset, 0)
                fourColAdrOffset = fourColAdrOffset + 1
            End If

            If singleColCounter = 5 Then
                Set outputRange = Worksheets(4).Range("A1").Offset(fiveColAdrOffset, 0)
                fiveColAdrOffset = fiveColAdrOffset + 1

            End If

            If singleColCounter = 6 Then
                Set outputRange = Worksheets(5).Range("A1").Offset(sixColAdrOffset, 0)
                sixColAdrOffset = sixColAdrOffset + 1
            End If

            If singleColCounter = 7 Then
                Set outputRange = Worksheets(6).Range("A1").Offset(sevenColAdrOffset, 0)
                sevenColAdrOffset = sevenColAdrOffset + 1
            End If

            If singleColCounter > 0 Then
             
            MoveAdr startRange.Offset(offsetCounter - singleColCounter, 0), outputRange.Offset(0, 0), singleColCounter

            ' PLZ splitten
            Dim plzAndName As String
            plzAndName = outputRange.Offset(0, singleColCounter - 1).Value

            outputRange.Offset(0, singleColCounter - 1).Value = Split(plzAndName)(0)
            outputRange.Offset(0, singleColCounter).Value = Split(plzAndName)(1)
                
End If
           
'
'            If singleColCounter = 5 Then
'                outputRange.Offset(outputRowIdx, outputColIdx).Value = outputRange.Offset(outputRowIdx, outputColIdx - 1).Value
'                outputRange.Offset(outputRowIdx, outputColIdx - 1).Value = ""


'                outputRange.Offset(outputRowIdx, outputColIdx).Value = outputRange.Offset(outputRowIdx, outputColIdx - 2).Value
'                outputRange.Offset(outputRowIdx, outputColIdx - 2).Value = ""

'            End If


'            If singleColCounter = 4 Then
'                outputRange.Offset(outputRowIdx, outputColIdx + 1).Value = outputRange.Offset(outputRowIdx, outputColIdx - 1).Value
'                outputRange.Offset(outputRowIdx, outputColIdx - 1).Value = ""


'                outputRange.Offset(outputRowIdx, outputColIdx).Value = outputRange.Offset(outputRowIdx, outputColIdx - 2).Value
'                outputRange.Offset(outputRowIdx, outputColIdx - 2).Value = ""
'
'            End If

'            If singleColCounter = 3 Then
'                outputRange.Offset(outputRowIdx, outputColIdx + 1).Value = outputRange.Offset(outputRowIdx, outputColIdx - 1).Value
'                outputRange.Offset(outputRowIdx, outputColIdx - 1).Value = ""
'
'                outputRange.Offset(outputRowIdx, outputColIdx).Value = outputRange.Offset(outputRowIdx, outputColIdx - 2).Value
'                outputRange.Offset(outputRowIdx, outputColIdx - 2).Value = ""

'            End If

            outputRowIdx = outputRowIdx + 1
            outputColIdx = 0
            singleColCounter = 0
        End If


'        outputRange.Offset(outputRowIdx, outputColIdx).Value = startRange.Offset(offsetCounter, 0).Value
        outputColIdx = outputColIdx + 1
        singleColCounter = singleColCounter + 1


        offsetCounter = offsetCounter + 1
    Loop Until offsetCounter = 18888


'    ActiveSheet.Paste

    
End Sub