Kopier række hvis kriterium er opfyldt og slet derefter de sidste 4 celler i kildedata

Hvis jeg har forstået dig ret, tror jeg flg. virker.

Glemte at indsætte flg. efter sægningen i kolonne A:



Ellers giver det en fejl, hvis værdien ikke blev fundet i kolonne A.

Tak for dit input.

Jeg har indsat dine to tilføjelser i makroen.
Er ikke helt sikker på at jeg har indsat linjen,
"If Not rFind Is Nothing Then" (efter sætningen i kolonne A), det rigtige sted.

Når jeg kører makroen, sker der ikke noget.

Jeg har uploadet et eksempel:
http://gupl.dk/706948/

Så vidt jeg kan se, søger makroen "kun" efter værdien "123456" i de tre områder og kolonne A.

Det er meningen, at der skal søges ud fra alle de værdier der forekommer i de tre områder, og derefter søge efter et eventuelt match med en værdi i kolonne A. I eksemplet er det 5 værdier, men det kan være mange flere.

Hvis der findes et match, skal rækken kopiers og indsættes i tabel 1 (Range N50), og de 4 sidste celler skal slettes i rækken i kildeområdet.


Makroen (med de 2 tilføjelser)

Sub TestFlytOgSlet2()
Dim rRange1 As Range
Dim rRange2 As Range
Dim rRange3 As Range
Dim dHit As Double
Dim lCount As Long

On Error GoTo ErrorHandle

Application.ScreenUpdating = False

Worksheets("Ark1").Activate

Set rRange1 = Range("P10:P30")
Set rRange2 = Range("R13:R33")
Set rRange3 = Range("U11:U31")

'Tjekker om værdien findes
dHit = Application.WorksheetFunction.CountIf(rRange1, 123456)
If dHit = 0 Then
  dHit = Application.WorksheetFunction.CountIf(rRange2, 123456)
End If
If dHit = 0 Then
  dHit = Application.WorksheetFunction.CountIf(rRange3, 123456)
End If

'Hvis værdien ikke fandtes, forlades proceduren
If dHit = 0 Then Exit Sub

Set rRange1 = Range("A1:A300")

'Søg værdien i kolonne A1 til A300
Set rRange2 = rRange1.Find(123456)
If Not rFind Is Nothing Then

'Gennemløb A1 til A300. Hvis værdien findes.
'kopieres osv. Skal målområdet slettes først,
'kræver det et par linjer her.
With rRange1
  For lCount = 1 To 300
      If .Item(lCount).Value = 123456 Then
        Set rRange3 = Range("N50")
        'Find indsætningspunktet
        If Len(rRange3.Value) > 0 Then
            If Len(rRange3.Offset(1, 0).Value) > 0 Then
              Set rRange3 = rRange3.End(xlDown).Offset(1, 0)
            Else
              Set rRange3 = rRange3.Offset(1, 0)
            End If
        End If
        'Kopier
        Range(.Item(lCount), .Item(lCount, 11)).Copy rRange3
        'Slet de sidste 4 celler i området, der blev
        'kopieret fra
        Range("H" & lCount, "K" & lCount).ClearContents
      End If
  Next
End With
End If

BeforeExit:
Set rRange1 = Nothing
Set rRange2 = Nothing
Set rRange3 = Nothing
Application.ScreenUpdating = True

Exit Sub
ErrorHandle:
MsgBox Err.Description
Resume BeforeExit
End Sub

Så trænger vi til lidt præcision i beskrivelsen:

Skal det forstås sådan, at for hver værdi/celle i de tre områder skal det tjekkes, om der er et match i kolonne A1:A300?

Og er det altid de samme 3 områder (P10:P30 osv.)?

Kan der forekomme dubletter i de 3 områder, og hvordan skal de i givet fald behandles? Hvis der fx er 2 forekomster i P10:30 og 2 forekomster i A1:300, skal forekomst 2 så matches med forekomst 2?

Hvis der kun er 1 forekomst i P10:P30 osv. og flere i A1:300, skal alle forekomster i A1:300 så behandles, eller ...?

Tjek om der er et match:
Det er rigtigt forstået, - for hver værdi/celle i de tre områder skal det tjekkes, om der er et match i kolonne A1:A300.

De 3 områder:
I eksemplet er det de samme 3 områder (P10:P30 osv.).
Men når jeg skal bruge makroen fremadrette, vil der kunne komme andre områder til. Men det kan jeg sikkert selv skrive ind i makroen på et senere tidspunkt. Når jeg ved hvordan det fungerer :)

Dubletter i de 3 områder og kolonne A:
Der kan ikke forekomme dubletter i de 3 områder, og heller ikke i området A1:300. Hvis værdien forekommer i A1:A300, er det kun i én celle (kolonne A).

Jeg kan godt se, at jeg fra starten skulle have lavet en mere detaljeret beskrivelse af problemet.
Håber at de nye oplysninger giver mening.

Okay, nu tror jeg, at jeg er med. Jeg har delt det op i 3 procedurer, hvor det er den første der styrer begivenhederne.

Det er lige præcis sådan makroen skal fungere.
Den gennemløber kolonne A, hvis et match findes med en værdi i de tre områder, - kopieres rækken i kilde-data og indsættes som den skal (Range N50). Derefter slettes de 4 sidste celler i rækken i kilde-data.
Det fungerer helt igennem efter hensigten. Super godt arbejde :)

Du skal have mange tak for hjælpen.
Sender du et svar, så jeg kan give dig point.

Laugesen

Det var godt :-)

Nu har jeg lavet en tilpasning, så makroen kører på det ark den er tiltænkt.
Det er en fornøjelse at se det fungere, og det sparer mig for mange kopier/indsæt/slet-handlinger :)

Endnu engang tak for hjælpen med at lave denne makro :)

Laugesen

Velbekom, det er en fornøjelse, når tingene virker :-)