VBA/Makro til at flytte indhold af celler - under betingelser

Nå min fine oversigt med kolonner er blevet ødelagt af reklamebanneret... ÆV

Prøver igen:

Dataeksempel fra Excel:

          Kol A  Kol B  Kol C

Record 1:          Tekst  Beløb
                  Nummer

Record 2:          Tekst  Beløb
                  Tekst
                  Nummer

Record 3:          Tekst  Beløb
                  Tekst
                  Tekst
                  Nummer

prøv lige at formatere det igen, gerne sådan:

A1=Record1 B1=Tekst C1=Beløb eller hvor de nu står

for ellers bliver det rent gætteværk, hvor de enkelte værdier står

Prøver lige igen, igen:

A1: (tom)  B1: 'Kundenavn A'    C1: Saldo A
A2: (tom)  B2: 'Kundenr A'
A3: (tom)  B3: 'Kundenavn B'    C3: Saldo B
A4: (tom)  B4: 'navn B fortsat'
A5: (tom)  B5: 'Kundenr B'
A6: (tom)  B6: 'Kundenavn C'    C6: Saldo C
A7: (tom)  B7: 'navn C fortsat' 
A8: (tom)  B8: 'navn C fortsat' 
A2: (tom)  B9: 'Kundenr C' 

Data er en masse rækker i excel, hvor data hører sammen. Nogle data har 2 rækker der hører sammen (Kunde A) andre har 3 (Kunde B) og andre igen har 4 rækker (Kunde C).

Opgaven går på at få Kundenummeret, der står med skiftende afstand fra Kundenavnet, op at stå på samme linie som Kundenavnet og Kundesaldoen.

Ex. Kunde A: celle B2 skal flyttes til A1
Ex. Kunde B: celle B5 skal flyttes til A3
Ex. Kunde C: celle B9 skal flyttes til A6

Der er skiftende forekomster af "typerne" A, B og C i datamaterialet, dvs. der kan komme 3 kunder med hver 4 linier efter hinanden.

Kundenavn og Kundesaldo står altid i samme række, det er denne række jeg ønsker at beholde og tilføje kundenummeret til.

Giver det mening?

mvh Thomas

ja det hjalp en hel del :-)

kunde nr. består det af tal og kun tal ?

Yes fra 5 til 7 cifre

Kundenr: Heltal 5-7 cifre
Saldo:  "Long" med to decimaler

Private Sub CommandButton2_Click()
Sidste = Cells(65536, 2).End(xlUp).Row
Forrige = Sidste
For I = 1 To Sidste - 1
    If Cells(Sidste - I, 3).Value <> "" Then
        Temp = Cells(Forrige, 2).Value
        Cells(Sidste - I, 1).Value = Temp
        Cells(Forrige, 2).Value = ""
        Forrige = Sidste - I - 1
    End If
Next
End Sub

Også et bud:
Dim antalRæk, ræk1
Sub flytNummer()
Dim ræk, nummer, tilRæk
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
   
Rem Find recordens række 1
    For ræk = 1 To antalRæk
        If Cells(ræk, 3) <> "" Then
            ræk1 = ræk
           
            nummer = findNummer(ræk, tilRæk)
            If nummer <> "" Then
                ræk = tilRæk
                Cells(ræk1, 1) = nummer
            End If
        End If
    Next ræk
    MsgBox ("Flytning er alsluttet")
End Sub
Private Function findNummer(fraRæk, tilRæk)
Dim f
    For f = fraRæk To antalRæk
        If IsNumeric(Cells(f, 2)) = True Then
            findNummer = Cells(f, 2)
            Cells(f, 2) = ""
            tilRæk = f
            Exit Function
        End If
    Next f
    findNummer = ""
End Function

Hej Supertekst
Hvordan får jeg din kode afviklet?
mvh Thomas

akyhne: din kode virker fint!

Hej Thomas
Sæt koden ind i xls-filens VBA-vindue (Alt+F11) / Ark1 og kør (F5)

Hej, og 1000 tak!

Begge løsninger virker - jeg mangler bare et 'svar' fra akyhne for at kunne tildele point. I deler 50/50, OK?

mvh Thomas

Det er ok med mig.

OK og selv tak...