Hallo zusammen,

ich hatte bereits eine Anfrage gestellt, leider ohne Erfolg. Deshalb versuche ich es noch einmal. Bei nachfolgendem Code suche ich eine Lösung wie ich die einzelnen Zeilen (jede Zeile steht für die Kopie einer bestimmten spalte) verkürzen kann:

LetzteZeile = WS2.Range("A65536").End(xlUp).Row

For iZeile = 2 To WS1.Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 1).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row + 1, 1)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 2).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 2)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 3).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 3)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 4).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 4)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 5).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 5)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 6).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 6)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 7).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 7)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 8).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 8)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 9).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 9)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 10).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 10)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 11).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 11)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 12).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 12)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 13).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 13)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 14).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 14)
If WorksheetFunction.CountIf(WS2.Range(mySpalte2 & "2:" & mySpalte2 & LetzteZeile), WS1.Cells(iZeile, mySpalte1)) _
> 0 Then WS1.Cells(iZeile, 15).Copy WS3.Cells(WS3.Range("a65536").End(xlUp).Row, 15)

Next iZeile


meine letzte Anfrage war hier:

https://www.herber.de/forum/archiv/288to292/t288991.htm

Besten Dank für eine Hilfe!

mfg
Erich