How to find value of cell above each cell - vba

Question

I want to screen all sheets for values that starts with "D"
In the sheets I formed blocks (1 column, 4 rows) with
- owner
- area
- parcel (that is allways starting with a "D")
- year of transaction (blocks of 1 column and 4 rows).
I want to make a summary in sheet "Test".
I'm able to find the parcel, but how can I get the info from the cell above?
Sub Zoek_kavels()
Dim ws As Worksheet
Dim rng As Range
Dim Area
Dim Kavel As String
rij = 1
For Each ws In ActiveWorkbook.Sheets
Set rng = ws.UsedRange
For Each cell In rng
If Left(cell.Value, 1) = "D" Then 'Starts with D
Sheets("Test").Cells(rij, 1) = cell.Value 'Kavel D..
Cells(cell.row - 1, cell.Column).Select
Area = ActiveCell.Value
Sheets("Test").Cells(rij, 2) = Area 'Oppervlakte
Sheets("Test").Cells(rij, 3) = ws.Name 'Werkblad naam
rij = rij + 1
End If
Next
Next
End Sub

Answer 1

A nice simple loop should do the trick, you may have had spaces in the worksheet, that would throw off the used range.
Here is a different approach.
Sub Get_CellAboveD()
Dim LstRw As Long, sh As Worksheet, rng As Range, c As Range, ws As Worksheet, r As Long
Set ws = Sheets("Test")
For Each sh In Sheets
If sh.Name <> ws.Name Then
With sh
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A1:A" & LstRw)
If LstRw > 1 Then
For Each c In rng.Cells
If Left(c, 1) = "D" Then
r = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
ws.Range("A" & r).Value = c
ws.Range("B" & r).Value = c.Offset(-1).Value
ws.Range("C" & r).Value = sh.Name
End If
Next c
End If
End With
End If
Next sh
End Sub

Answer 2

There are two important points (and two not so important) to take care of your code:
start from row 2, because you are using .row - 1. Thus, if you start at row 1, row-1 would throw an error;
try to avoid Select, ActiveCell, etc.;(How to avoid using Select in Excel VBA);
write comments in English, not in Dutch (also good idea for variable names as well, rij or kavel do not help a lot);
declare the type of your variables, e.g. dim Area as String or as Long or anything else;
Option Explicit
Sub ZoekKavels()
Dim ws As Worksheet
Dim rng As Range
Dim Kavel As String
Dim rij As Long
Dim cell As Range
rij = 2 'start from the second row to avoid errors in .Row-1
For Each ws In ActiveWorkbook.Worksheets
Set rng = ws.UsedRange
For Each cell In rng
If Left(cell, 1) = "D" Then
With Worksheets("Test")
.Cells(rij, 1) = cell
.Cells(rij, 2) = ws.Cells(cell.Row - 1, cell.Column)
.Cells(rij, 3) = ws.Name
End With
rij = rij + 1
End If
Next
Next
End Sub
Or you can use .Cells(rij, 2) = cell.Offset(-1, 0) instead of Cells(cell.Row - 1, cell.Column), as proposed in the comments by #Shai Rado.