VBA - Kopier rækker fra Ark1 vha. Search String "X" til nyt ark

Dim currentSheet As String
currentSheet = ActiveSheet.Name
Dim searchString As String
searchString = "Kopi bedes underskrives."

Skal lige rettes til "Kopi bedes underskrives." til "Kopi Returneres."

Jeg er måske ikke helt med, men kan du ikke tage den sidste række - 10 ?

MyLastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0).Row -10


Ellers kan du måske bruge denne:
    myLastRow = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByRows).Row

Jeg skal bare kopier alt mellem (Ark1)række 3 og teksten "Gyldighed". Værdien "Gyldighed" er dynamisk da der kommer rækker ind imellem række 3 og rækken hvor ""Gyldighed" står.
Det hele skal kopieres over i Ark2 med format.

Jeg kan ikke lige gennemskue din løsning, men det må være noget med at den finder sidste række med data i og springer 10 rækker tilbage.?

Pejsen

Kan man ikke lave noget med autofilter

Fra A3 til Gyldig. men der er blanke rækker i mellem, og de skal med.

Nedenstående virker kun hvis der er data i alle rækkerne + den laver " Sæt ind" istedet for "Indsæt det kopiere og ryk celler ned af"


CopyMatchingRows()
    With Worksheets("Ark1")
        .AutoFilterMode = False
        With .Range("A3:H3")
            .AutoFilter
            .AutoFilter Field:=1, Criteria1:="Gyldighed: Tilbudet er gældende i 30 dage."
                                Criteria1:="<>"
        End With

        .AutoFilter.Range.Copy Destination:= _
        Worksheets("Ark2").Cells(Rows.Count, 1).End(xlUp)(0, 1)
        .AutoFilterMode = False
    End With

denne kode finder den sidste række hvor kuk indgår

Sub Button1_Click()
    mylastrow = Cells.Find("kuk", After:=Cells(1, 1), _
        LookIn:=xlFormulas, LookAt:=xlWhole, _
        SearchDirection:=xlPrevious, _
        SearchOrder:=xlByRows).Row
    MsgBox mylastrow
End Sub

henter fra række 3 til kuk og indsætter i ark2 fra A1

    Sheets("ark1").Select
    mylastrow = Cells.Find("kuk", After:=Cells(1, 1), _
        LookIn:=xlFormulas, LookAt:=xlWhole, _
        SearchDirection:=xlPrevious, _
        SearchOrder:=xlByRows).Row
    Rows("3:" & mylastrow).Select
    Selection.Copy
    Sheets("ark2").Select
    Rows("1:1").Select
    ActiveSheet.Paste

Sub CopyDynamicRange()

Dim i As Integer
Dim startCell As Integer

startCell = 9

Dim searchString As String
searchString = "Kopi Returneres."

Hvad siger du til denne her??????


Dim celleId As Integer
celleId = 0

i = 0
For i = 1 To 200
  If Worksheets("ARK2").Cells(i, 1).Value = searchString Then
    celleId = i
  End If
Next

If celleId <> 0 Then
    For i = startCell To (celleId - 2)
        Rows(startCell).Select
        Selection.Delete Shift:=xlUp
    Next
    Worksheets(ARK2).Range("A1:C5").ClearContents
   
End If

i = i + 1

   
Application.ScreenUpdating = False
startCell = 9

i = 0
'Find the last row
Dim LastRow As Long
With Worksheets(ARK1)
LastRow = _
      .Cells.Find("*", after:=.Cells(1), _
        LookIn:=xlFormulas, lookat:=xlWhole, _
        searchdirection:=xlPrevious, _
        searchorder:=xlByRows).Row
End With
       
With Worksheets("ARK1").Select
    Range("A1").Select
    Selection.Copy
    Sheets("ARK2").Select
    Range("A1").Select
    ActiveCell.PasteSpecial Paste:=xlValue, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
End With
Set ws = ThisWorkbook.Sheets("ARK1")
    Worksheets(ARK2").Rows(startCell + i).Select
    Selection.Insert Shift:=xlDown
    With Worksheets("ARK!).Select
    'Find the last row
    Range("A9", Cells(LastRow - 7, 8)).Select
    Selection.Copy
    Sheets("ARK2").Select
    Range("A9").Select
    ActiveCell.Insert Shift:=xlDown
   
  End With

Hvad siger du til ovenstående kode????

Det ved jeg ikke rigtigt?, virker den?

Der er nok noget galt her:
  With Worksheets("ARK!).Select
    'Find the last row

Jeg kan ikke se hvorfor du bruger with

Du kan evt. sende mig en filen

lemming,j(a)gmail,com

,=.

Det blev den her Kode som virker rigtig godt!
Et sidste spørgsmål er: Kan man skifte fokus til A1 hvergang man skifter mellem 4 ark.

Tak for hjælpen

Sheets("ARK2").Select
    mySearch = Cells.Find("Kopi  returneres.", After:=Cells(7, 1), _
        LookIn:=xlFormulas, LookAt:=xlWhole, _
        SearchDirection:=xlPrevious, _
        SearchOrder:=xlByRows).Row - 2
        Rows("9:" & mySearch).Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.Range("A1:C5").ClearContents
Application.ScreenUpdating = False

Worksheets("ARK1").Select
        Range("A1").Select
        Selection.Copy
        Sheets("ARK2").Select
        Range("A1").Select
        ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Sheets("ARK1").Select
    mylastrow = Cells.Find("Gyldighed: Tilbudet er gældende i 30 dage.", After:=Cells(7, 1), _
        LookIn:=xlFormulas, LookAt:=xlWhole, _
        SearchDirection:=xlPrevious, _
        SearchOrder:=xlByRows).Row - 1
        Rows("9:" & mylastrow).Select
        Selection.Copy
        Sheets("ARK2").Rows("9:9").Insert Shift:=xlDown
        Worksheets("ARK2").Activate
        ActiveSheet.Cells("1:1").Select
("1:1").Select

Jlemming smid lige svar, så skal du få point

Velbekomme :o)


medh ensyn til: Kan man skifte fokus til A1 hvergang man skifter mellem 4 ark
Forventer jeg at du mener når man skifte manuel, altså udenfor den anden god.

Indlæg denne kode under thisworkbook

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Range("A1").Select

End Sub

Lige nøjagtigt... :-)



Tak for det