|
Hallo
Eine Möglichkeit und auch sehr schnell.
Option Explicit
Sub Spezialkopieren()
Dim anfgArr As Variant, plusArr As Variant, summArr As Variant
Dim x As Long, y As Long
' Daten einlesen
With ThisWorkbook.Worksheets("Tabelle1")
anfgArr = .Range("B2:K11").Value ' Ausgangsbereich --> anpassen
plusArr = .Range("B15:K24").Value ' Suumierbereich --> anpassen
summArr = anfgArr ' Array clonen
For x = 1 To UBound(anfgArr, 1)
For y = 1 To UBound(anfgArr, 2)
If anfgArr(x, y) = vbNullString And plusArr(x, y) <> vbNullString Then
summArr(x, y) = plusArr(x, y)
End If
Next y
Next x
' Ausgabe beginnend bei Zelle B28 im Tabellenblat 'Tabelle1'
.Range("B28").Resize(UBound(summArr, 1) - LBound(summArr, 1) + 1, _
UBound(summArr, 2) - LBound(summArr, 2) + 1) = summArr
End With
End Sub
mfg GraFri |