Hallo! >Also hier nochmal dein Code leserlich. Was geht denn nicht bzw. was soll noch ergänzt werden (mehrere Spalten wurden erwähnt) ? VG

Option Explicit
Sub BWTest()

Dim eing As Integer
Dim eing2 As Integer
Dim s As Integer
Application.ScreenUpdating = False
ende = ThisWorkbook.Sheets("SAPBW_DOWNLOAD").Range("b12000000").End(xlUp).Row
'eing = InputBox("Suchspalte")
eing2 = InputBox("Ausgabe Zelle")
For k = 96 To ende
    s = Cells(k, Columns.Count).End(xlToLeft).Column
    For y = 9 To eing2 - 1
        If Cells(k, y).Value = 0 Then
            Cells(k, y).Value = ""
        End If
    Next y
    s = Cells(k, Columns.Count).End(xlToLeft).Column
    If s = 1 Then
        Rows(k).Delete
    Else
        Waehrung = CustomFormatText(ThisWorkbook.Sheets("SAPBW_DOWNLOAD").Cells(k, s))
        If Waehrung <> "*" And Waehrung <> "" Then
            ThisWorkbook.Sheets("SAPBW_DOWNLOAD").Cells(k, eing2).Value = Waehrung
        End If
    End If
Next k
Application.ScreenUpdating = True
End Sub

Function CustomFormatText(Cell) As String

Dim i As Long
Dim x As String
Dim CustomFormatString As String
Dim FirstQuote As Boolean
Dim SecondQuote As Boolean
FirstQuote = False
SecondQuote = False
CustomFormatString = Cell.NumberFormat
If Right(CustomFormatString, 1) = "$" Then
    CustomFormatText = "$"
    GoTo TheEnd
End If
For i = 1 To Len(CustomFormatString)
    x = Mid$(CustomFormatString, i, 1)
    ' Find the first quote sign in the custom format
    If FirstQuote = False Then
        If Asc(x) = 34 Then

            If x = "$" Then
                CustomFormatText = "$"
                GoTo TheEnd
            End If
            FirstQuote = True
            GoTo GetNextCharacter
        End If
    End If
' Find the second quote sign in the custom format
    If FirstQuote = True Then
        If Asc(x) = 34 Then
            SecondQuote = True
            GoTo TheEnd
        End If
    End If
' Write out the characters between the first and second quote
    If FirstQuote = True And SecondQuote = False Then
        CustomFormatText = CustomFormatText + x
    End If
GetNextCharacter:
Next i
TheEnd:
End Function