Avatar billede lstevns Mester
08. februar 2017 - 13:40 Der er 1 løsning

Hjælp til makro

Hej
Jeg har et datasæt hvori at kolonne C er medarbejder numre, medarbejder numrene fremgår med flere rækker og forskellige antal rækker pr. medarbejder nummer.
Jeg vil gerne have indsat 3 tomme rækker under hvert sidste medarbejder nummer. Og derefter kopieret data i nogle af ovenstående kolonner.
Jeg har brugt denne programmerings kode:

      Sub Rækker()
                    Dim Sidstecelle As String
                    Sidstecelle = Range("B17").End(xlDown).Row
                   
                    Range("B" & Sidstecelle + 1).Select
                    ActiveCell.FormulaR1C1 = "Slut"
                   
                    Dim startC As Long
                    Dim slutC As Long
                   
                    startC = 17
                    slutC = 17
                    Dim iC As Long
                   
                    Dim nuvaerendeC As String
                    nuvaerendeC = Range("C" & startC) ' medarbejder#
                   
                    iC = 17
                    Do While Range("B" & iC) <> "Slut" ' søjle B
                   
                      If Range("C" & iC) = nuvaerendeC Then
                            slutC = iC
                   
                        Else
                            Rows(slutC + 1 & ":" & slutC + 3).Select
                            Selection.Insert Shift:=xlDown
                            Range("B" & slutC & ":" & "N" & slutC).Select
                            Selection.Copy
                            Range("B" & slutC + 1).Select
                            ActiveSheet.Paste
                            Range("B" & slutC + 2).Select
                            ActiveSheet.Paste
                            Range("B" & slutC + 3).Select
                            ActiveSheet.Paste
                           
                            startC = iC
                            slutC = iC
                            nuvaerende = Range("C" & iC)
                        End If
                       
                        iC = iC + 1
                     
                    Loop
    End Sub

Men den kører i ring efter den har indsat rækkerne, hvordan kan jeg få den til at forstå at når den har indsat rækkerne skal den starte forfra med medarbejder nummeret nedenunder de nye rækker??

Håber mit spørgsmål er klart nok.
Avatar billede kabbak Professor
08. februar 2017 - 14:57 #1
du skal køre baglæns op i arket, prøv at teste:

Sub Rækker()
    Dim Sidstecelle As String, startC As Long, nuvaerendeC As String, iC As Long

    Sidstecelle = Range("B17").End(xlDown).Row + 1
  '  Range("B" & Sidstecelle) = "Slut"
    startC = 17    ' Data starter i række 17

    For iC = Sidstecelle To startC Step -1
        If Range("C" & iC) <> Range("C" & iC - 1) Then ' medarbejder#
            Range("B" & iC & ":" & "N" & iC).Copy
            Range(Range("B" & iC + 1), Range("N" & iC + 3)).Insert Shift:=xlDown
        End If
    Next
End Sub
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester