01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33 |
|
Sub Datenuebertragung()
Dim izeile As Long, iZeileout As Long
Dim WShQ As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Set WShQ = ThisWorkbook.Sheets("Tabelle1") ' Quellblatt angeben
With ThisWorkbook.Sheets("Tabelle2") ' Zielblatt angeben
iZeileout = 70 ' Beginn-Zeile
For izeile = 50 To 70
If Not WShQ.Cells(izeile, "B").Value Like "nein" Then
.Cells(iZeileout, "A").Resize(, 2).Value _
= WShQ.Cells(izeile, "A").Resize(, 2).Value
.Cells(iZeileout, "F").Value = WShQ.Cells(izeile, "F").Value
iZeileout = iZeileout + 1
End If
Next izeile
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
|