Hi Forum,
Habe folgendes Makro und möchte es erweitern, klappt aber nicht. Das Makro sucht in allen Tabellenblättern nach Einträgen in der Spalte F und trägt dann diese + zugehörige Daten in ein anderes Tabellenblatt. Nun soll zusätzlich überprüft werden, ob in der Zelle Q2 ein Wert steht. Ist dies der Fall, soll dieser Wert in das andere Tabellenblatt("Übersicht") in die letzte freie Zelle der Spalte A eingetragen werden. Wer kann helfen?
Danke, Eleni
If ThisWorkbook.Sheets("Übersicht").Protect Then ThisWorkbook.Sheets_("Übersicht").Unprotect
ThisWorkbook.Sheets("Übersicht").Activate
Dim myWs As Worksheet
Dim fAddr As String
Dim lng As Long, zei As Long
Dim n
Set ws = Worksheets("Übersicht")
With ws
zei = 3
For Each myWs In ThisWorkbook.Worksheets
If myWs.Name ws.Name Then
lng = myWs.[f65536].End(xlUp).Row
For n = 3 To lng Step 10
myWs.Range("A" & n & ":A" & n).Copy
.Range("A" & zei).PasteSpecial Paste:=xlValues,_
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
.Cells(zei, 2) = myWs.Cells(n, 6)
myWs.Range("P" & n & ":P" & n + 9).Copy
.Range("C" & zei & ":L" & zei).PasteSpecial_ Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
myWs.Range("R" & n & ":R" & n).Copy
.Range("M" & zei).PasteSpecial Paste:=xlValues,_ Operation:=xlNone, SkipBlanks:=False, Transpose:=True
If myWs.Cells(Rows.Count, 11).End(xlUp).Value = "SUMME" Then
.Range("O" & zei).Font.ColorIndex = 1
.Range("O" & zei).Interior.ColorIndex = 4
.Range("O" & zei) = "JA"
Else: .Range("O" & zei).Font.ColorIndex = 1
.Range("O" & zei).Interior.ColorIndex = 3
.Range("O" & zei) = "NEIN"
End If
zei = zei + 1
Next n
End If
Next myWs
.Columns(2).NumberFormatLocal = "TT.MM.JJ"
For Each myWs In ThisWorkbook.Worksheets
If myWs.Name ws.Name Then
Do While myWs.Cells(2, 17).Value = True
myWs.Cells(2, 17).Copy
ThisWorkbook.Sheets("Übersicht").Cells(Rows.Count, 1).End_(xlUp).Offset(1, 0).Paste
Loop
End If
Next myWs
End With