Fra uendelige kolonner til uendelige rækker (VBA)

Sub FlytData()
Dim Koll As Integer
Dim Rækk As Integer
Dim NyeData As Integer

NyeData = 2
        Rækk = 2
          While Len(Ark1.Cells(Rækk, 1).Value) > 0
          For Koll = 2 To 13
                If Len(Ark1.Cells(Rækk, Koll).Value) > 0 Then
                Ark2.Cells(NyeData, 1) = Ark1.Cells(Rækk, 1).Value
              Ark2.Cells(NyeData, 2) = Right(Ark1.Cells(1, Koll).Value, 2)
                Ark2.Cells(NyeData, 3) = Ark1.Cells(Rækk, Koll).Value 'Evt værdie
                NyeData = NyeData + 1
                End If
                     
            Next Koll
              Rækk = Rækk + 1
            Wend
  End Sub

Hej Oleelo -

Undskyld ventetiden.

Har først set dit indlæg nu - har været en del på farten.

Jeg får nok først tid til at teste i aften.

MVH/Ø

Oleelo -

Det virker perfekt!
1000 tak for hjælpen.

/Ø

Ps.: Håber du hermed har fået dine point. Skal lige lære den nye portal at kende.

Hej
Tak jeg har fået mine point
mvh oleelo

Oleelo -

Fik du dine point eller gaflede jeg dem selv?

/Ø

Hej
ja du fik taget dine egne point men det er OK bare mit svar kan bruges :-)
mvh oleelo

Sorry! -

Jeg synes også det var lidt for nemt sluppet igennem - altså af mig. :-)

Du skal bare sige til, hvis du vil have dine point.
Løsning virker perfekt og gav desuden anledning til andre landvindinger. Så fremtidssikret var den også. :-)

BR/Ø