Set D = Worksheets("Daten")

dim rw as long

rw = 2
do until D.cells(rw,"A") =""
Set F = Worksheets( D.cells(rw,"A") )

i = 2


Do While Not IsEmpty(D.Cells(i, 1))
F.Cells(1, 1) = D.Cells(i, 1)
F.Cells(2, 2) = D.Cells(i, 2)
F.Cells(5, 2) = D.Cells(i, 3)
F.Cells(6, 3) = D.Cells(i, 4)
i = i + 1
Loop

rw=rw+1
loop


MsgBox "Job Done"
End Sub


"Volker Hormuth" wrote in message
...
Hello,

I have a problem with the processing within a loop. I have found examples
which copy, nevertheless, line-by-line and not cell-wise. Also with Ron de
Bruin I have found nothing, most examples summarise data. Here, therefore,
I ask for help.

My workbook exists of a data sheet and a big number of sheets which show
all same structure. These single sheets (for regions) should be updated
from the data sheet. All values should be simply overwrote.

In column A of the data sheet are the names of the single sheets. These
sheets should be processed with A2 ( A1 header)beginning up to the last
entry. Figure formattings must be preserved. These single sheets already
exist.

The sheets have following structu
DataSheet
A B C D E
1 Tablename Area1 Area2 Area3 Area4
2 RegionA 101 201 301 401
3 RegionB 0 202 302 0
4 RegionC 103 0 303 403

RegionSheet
A B C
1 RegionA
2 101
3 201
4
5 301
6 401

I have the following code. The loop by column A is still absent.

Sub RegionUpdaten()
Dim D, F As Worksheet
Dim i%

Set D = Worksheets("Daten")
Set F = Worksheets("RegionA")
i = 2

Do While Not IsEmpty(D.Cells(i, 1))
F.Cells(1, 1) = D.Cells(i, 1)
F.Cells(2, 2) = D.Cells(i, 2)
F.Cells(5, 2) = D.Cells(i, 3)
F.Cells(6, 3) = D.Cells(i, 4)
i = i + 1
Loop
MsgBox "Job Done"
End Sub

Many thanks for every tip.
Volker