Cellen invoegen in een bepaald bereik

[dinge]

Goedemiddag

In een bestandje heb ik de volgende code staan

Sub Row_Insert()

Dim a As Integer, DezeCat As String, VorigeCat As String

For a = 7 To 146
DezeCat = Sheets("Voorbeeld").Range("T" & a).Value
VorigeCat = Sheets("Voorbeeld").Range("T" & a - 1).Value

     If VorigeCat <> DezeCat And DezeCat <> "" Then
   
                                   Rows(a).Select
                                   Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove
     
                                    a = a + 1
     End If
     
Next a
 
End Sub

Deze code werkt prima, maar als ik 2 lijsten naast elkaar op 1 sheet heb is het probleem dat in de andere lijst ook cellen worden toegevoegd omdat deze code een rij invoegt.
Ik heb al van alles geprobeerd om alleen cellen in te voegen in een bereik van bijv. kolom A t/m I of kolom M t/m U.

Alleen als ik dat aangeef krijg ik foutmeldingen,.
Hetgene wat ikzelf geprobeerd heb is

Range("M:U").Select
Selection.Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove

en

Range("M:U").Select
Range("M:U").Insert Shift:=xlUp, CopyOrigin:=xlFormatFromLeftOrAbove

Maar zoals aangegeven werkt dat helaas niet, er worden nl. geen cellen ingevoegd ook niet als er xlup wordt veranderd in xldown.

Is het wel mogelijk om alleen cellen in een bepaald bereik in te voegen?

 

[edmoor]

Je geeft aan foutmeldingen te krijgen maar niet welke.
Zonder je document is er verder ook niks over te zeggen.

 

[dinge]

Goedenavond

Hierbij het bestand waarin ik het probleem mee heb.
Ik krijg Fout 1004 met de tekst "Er zijn geen cellen gevonden"

Bekijk bijlage Map1.xlsx.xlsm

 

[HSV]

Rijen invoegen doe je van onder naar boven ivm de telling.
Globaal wordt het dan zo.

Sub Row_Insert()
Dim a As long, DezeCat As String, VorigeCat As String
 For a = ActiveSheet.UsedRange.Rows.Count To 7 Step -1
   DezeCat = Sheets("finalisten").Range("T" & a).Value
   VorigeCat = Sheets("finalisten").Range("T" & a - 1).Value
  If VorigeCat <> DezeCat And DezeCat <> "" Then Range(Cells(a, "M"), Cells(a, "U")).Insert xlShiftDown, xlFormatFromLeftOrAbove
 Next a
End Sub

anders geschreven.

Sub Row_Insert()
Dim a As Long
With Sheets("finalisten")
 For a = .UsedRange.Rows.Count To 7 Step -1
  If .Range("T" & a).Offset(-1) <> .Range("T" & a) And .Range("T" & a) <> "" Then .Range(.Cells(a, "M"), .Cells(a, "U")).Insert , xlFormatFromLeftOrAbove
 Next a
End With
End Sub

Of:

Then .Cells(a, "M").resize(,9).Insert , 0

 

[dinge]

Beste HSV

De aangedragen oplossing doet inderdaad datgene wat ik voor ogen had.

Dank u wel voor de oplossing

:thumb::thumb::thumb::thumb::thumb: