Hvilken funktion/kode skal bruges for at springe 70 celler ned?

denne skriver i A1 den sidste række med værdi i området A2:A5000

Sub tst()
Dim t
For t = 2 To 5000 Step 70
If Cells(t, 1) <> "" Then Cells(1, 1) = t
Next
End Sub

men lad os se formlen og evt lidt mere info

Jeg har to projektmapper. Projektark1 og projektark2. Projektark2 består af de 5000 rækker med informationer. For hver 70 celler kommer en ny virksomhed med forskellige informationer, f.eks antal ansatte, omkostninger, antal ledere. Det er disse informationer jeg skal have ført over i Projektark1.

Selve overførslen er nem. Jeg konsoliderer rækkerne nedefter på et nyt ark i projektark2, og laver herfra en kæde til projektark1, hvor virksomhedernes totale antal ansatte mv nu står samlet. Problemet er, at med 5000 rækker, er der en del forskellige virksomheder, og det tager lang tid at markere de relevante rækker, som skal burges i konsolideringen. Jeg har derfor ikke noget egentlig kode, men mangler simpelthen noget kode eller en funktion, der kan springe de 70 rækker ned, (hvor der så kommer et nyt virksomhedsnavn), og så derefter fortsætte konsolideringen..

Den kode du skrev, hvordan kan jeg afvikle den? Hvordan kalder jeg den f.eks fra en anden makro inde fra excel?

Mvh
Regin
(Tak for hjælpen so far :) )

Jeg skal lige høre:


For at teste proceduren, vil jeg knytte den ti

du kan kalde den med : Call tst

vender tilbage når jeg har en løsning

skal lige vide om det handler om 2 forskellige Projektmapper (Excelfiler)
eller om det er 2 Ark i samme Projektmappe (Excelfil) ?

Det handler om 2 forskellige projektmapper.

Her er et eks. på hvordan værdier kan overføres til Projektmappe1
I eks. forudsættes at Projektmappe2 findes i C:\temp 'ret efter behov
I eks. overføres Firmanavn som forventes findes i cellerne 2,72 osv.
samt linierne 2,3,4 for hver firma
Disse indsættes i Ark2 fra række 1 i kolonne A,B,C,D
så vær opmærksom på at der ikke slettes evt.eksisterende data
opret evt. et nyt ark og ret i koden til dette ark så du kan teste
Dette er blot et eks, jeg ved jo ikke præsis hvilke celler du vil overføre
samt hvor i Projektmappe1 de skal placeres.

Sub tst()
Dim t, antal, rk
Workbooks.Open Filename:="C:\temp\Projektmappe2.xls"
rk = 1
For t = 2 To 5000 Step 70
If Cells(t, 1) <> "" Then antal = t 'Cells(1, 1) = t
Cells(t, 1).Copy Workbooks("Projektmappe1").Sheets("Ark2").Cells(rk, 1) ' Firmanavn
Cells(t + 1, 1).Copy Workbooks("Projektmappe1").Sheets("Ark2").Cells(rk, 2) ' Linie 2 i firma
Cells(t + 2, 1).Copy Workbooks("Projektmappe1").Sheets("Ark2").Cells(rk, 3) ' Linie 3 i firma
Cells(t + 3, 1).Copy Workbooks("Projektmappe1").Sheets("Ark2").Cells(rk, 4) ' Linie 4 i firma
rk = rk + 1
Next
Workbooks("Projektmappe2.xls").Close
End Sub

*