finde en celle der indholder XX og kopiere den til nederste lin

Sub xFind()
søgestreng = "*XX*" ' angiv evt. ny søgeværdi her
rk = Cells(1000, 1).End(xlUp).Row
x = Application.CountIf(Range("A1:A" & rk), søgestreng)
If x = 0 Then GoTo nomatch
adr = "A1"
On Error GoTo nomatch
For t = 1 To x
y = Range(adr & ":A" & rk).Find(søgestreng, LookIn:=xlValues, MatchCase:=True).Address
adr = y
Next
streng = Range(adr)
Range(adr).Clear
Cells(rk + 1, 1) = Application.WorksheetFunction.Substitute(streng, "XX", "")
Exit Sub
nomatch:
MsgBox ("Fandt ingen celler med ") & søgestreng
End Sub

Den kopierer fint teksten og fjerner XX, men den indsætter teksten i linien lige neden under.
Den skulle helst finde den sidste linie på siden.
KAn det lade sig gøre?

hvor mange kolonner har du data i (sidstekolonne) ?
går ud fra det stadig er kolonne A værdi skal være ?

Hvis jeg kører koden i et tomt testark virker det fint.
Men hvis jeg sætter koden ind i en anden kode som skal køre igennem alle mine åbne ark siger den at der er fejl i dimensioneringen.
Jeg har forsøgt at dimentionere de forskellige elementer, men kan ikke hitte ud af det.



Sub xFind()

Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets

søgestreng = "*XX*" ' angiv evt. ny søgeværdi her
rk = Cells(1000, 1).End(xlUp).Row
x = Application.CountIf(Range("A1:A" & rk), søgestreng)
If x = 0 Then GoTo nomatch
adr = "A1"
On Error GoTo nomatch
For t = 1 To x
y = Range(adr & ":A" & rk).Find(søgestreng, LookIn:=xlValues, MatchCase:=True).Address
adr = y
Next
streng = Range(adr)
Range(adr).Clear
Cells(rk + 5, 1) = Application.WorksheetFunction.Substitute(streng, "XX", "")
Exit Sub
nomatch:
'Så skal den intet gøre og gå videre til næste ark

Next

End Sub

jeg bruger kun kolonne A

Hvis det er for bøvlet / svært / mærkeligt at få den til at komme nederst på siden kunne man måske skrive følgende kode/variabel istedet:

xx4xx så skal den kopiere 4 linier ned
xx5xx så skal den kopiere 5 linier ned osv.

Men så skal de første 5 cifre jo slettes istedet for kun "XX"

Hvis det kun er kolonne A, så virker koden i det ark som er aktivt når koden køres ikke ?

jo, når jeg kører i mit test ark gør det, men når jeg sætter den ind i et andet ark med andre koder beder den om dimensionering.
Mærkeligt.

Det ark jeg sidder og retter i er ikke noget jeg selv har lavet.
Øverst i koden står der dimensioneret for alle koder og der står der:
"Option Explicit"

Kan det have noget med at gøre, at dette ark beder om dimensionering

ja enten skal du slette Option Explicit
ellers skal alle variable være dimensioneret

hvis koden skal virke i alle ark, skal der ud over det du har tilføjet (For each ws....) indsætte ws. foran alle ranges/cells
fx.:
rk = ws.Cells(1000, 1).End(xlUp).Row
x = Application.CountIf(ws.Range("A1:A" & rk), søgestreng)
osv..
sig til hvis det driller

Nu har jeg forsøgt at dimensionere, men så går det galt.
Kan jeg få en hjælpende hånd til hvad der skal stå :-)

Dim søgestreng As String
Dim rk As Integer
Dim x As Integer
Dim adr As Integer
Dim t As Integer
Dim y As Integer
Dim streng As Integer

prøv:

Dim søgestreng As String
Dim rk As Integer
Dim x As Integer
Dim adr As String
Dim t As Integer
Dim y As String
Dim streng As String

Jep, det var lige det der skulle til. Nu er de dimensioneret korrekt.
Takker

Kunne man evt. lave en variabel til det antal linier, den omtalte celle linie skal kopieres ned?
Et forslag kunne være en af nedenstående koer i stedet for XX som vi er startet med.

xx4xx så skal den kopiere 4 linier ned
xx5xx så skal den kopiere 5 linier ned osv.

Antallet af linier der skal kopieres ned ligger indenfor 2-7 linier. Så måske man kan gøre det med en IF-sætning?

Det tal som er i xx?xx er det altid nr. 3 fra venstre ?

ja, det er ALTID nr. 3 fra venstre og tallet er altid 2-7

ok så prøv :

Sub xFind()
Dim søgestreng As String
Dim rk As Integer
Dim x As Integer
Dim adr As String
Dim t As Integer
Dim y As String
Dim streng As String

søgestreng = "*xx?xx*" ' angiv evt. ny søgeværdi her
rk = Cells(1000, 1).End(xlUp).Row
x = Application.CountIf(Range("A1:A" & rk), søgestreng)
If x = 0 Then GoTo nomatch
adr = "A1"
On Error GoTo nomatch
For t = 1 To x
y = Range(adr & ":A" & rk).Find(søgestreng, LookIn:=xlValues, MatchCase:=True).Address
adr = y
Next
streng = Range(adr)
tal = Mid(streng, 3, 1)
Range(adr).Cut Range(adr).Offset(tal, 0)
Range(adr).Offset(tal, 0) = Application.WorksheetFunction.Substitute(streng, "xx" & tal & "xx", "")

Exit Sub
nomatch:
MsgBox ("Fandt ingen celler med ") & søgestreng
End Sub

obs: ny variabel hvis den skal dimensioneres
Dim tal As Integer

?

Sorry, var lige opslugt af at teste og få det til at virke.
Det virker lige som det skal, da først jeg fik lavet den sidste Dim.

Denne kodestump skal jeg nok få meget ud af.

Jeg takker for indsatsen :-)