Auteur Topic: Waarde zoeken (gelezen 569 keer)

Sunnybat · « **Gepost op:** 02 maart 2023, 15:44:02 »

Hoi,

klein vraagje

in Blad2 staat in cel A PAP
is het mogelijk dat de regels die in blad1 staan ook in Cel A
kunnen worden overgenomen in blad2?

SoftAid · « **Reactie #1 Gepost op:** 02 maart 2023, 16:29:57 »

Hallo Sunnybat,

ik heb bij je vorige vraag (macro) je tekst aangepast.
Je verwijst naar een kolom met "cel A" of "Cel C" enzovoorts

Ook je "regels" is een foute benaming van Rijen

Dat leest slecht, en kan voor verwarring zorgen.

En op welke voorwaarden dienen de rijen (met PAP) overgebracht worden naar Blad2 ?

Hoe duidelijker je vraag, hoe duidelijker de antwoorden....

SoftAid

Sunnybat · « **Reactie #2 Gepost op:** 02 maart 2023, 17:31:44 »

@SoftAid

Oeps sorry
mijn vraag is eigenlijk en of dat mogelijk is ? dat
in blad2 CEL A1 tot en met CEL A10 ( kan meer zijn ) staat allemaal in CEL A PAP
in blad1 in cel A1 tot met A10 ( kan ook meer zijn ) staan PAP en andere tekst
nu is mijn vraag als er in blad2 in cel A bepaalde tekst voorkomt nu BV PAP dat hij heel de cellen
overneemt A1 tot en met Y1 dus ( 1,2,3,4,5,)
nu staat er in blad2 Cel A2 weer PAP en nu komt denk ik het moeilijkste nu moet de volgende PAP regel die voorkomt in blad1
in blad2 Cel A2 tot en met Y2 komen ( 25,26,27,28 ) en verder
op Blad1 komt op regel A3 weer PAP voor en deze moet dan weer in blad2 A2 tot en met Y2 komen

Alvast super bedankt

SoftAid · « **Reactie #3 Gepost op:** 02 maart 2023, 19:20:41 »

Hallo sunnybat,

hier een werkende code, maar het kan waarschijnlijk korter. Maar zelf geef ik er niet om als de code wat langer is, als ik ze maar kan lezen.

Het stukje om de lege rijen op Blad2 te verwijderen heb ik even van het internet gepikt.

Maak een module aan en zet deze code er in:

Code: [Selecteer]

Sub PAP()

    Worksheets("Blad1").Select
    x = InputBox("Welke naam zoek je?")
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    For rij = 1 To lastrow
             If Cells(rij, 1) = x Then
            Sheets("Blad1").Cells(rij, 1).EntireRow.Copy Destination:=Sheets("Blad2").Cells(rij, 1)
        End If
    Next
    
    'Lege rijen verwijderen in "Blad2"
    Dim b As Long
 Worksheets("Blad2").Select
With ActiveSheet

    For b = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
        If WorksheetFunction.CountA(.Rows(b)) = 0 Then
            ActiveSheet.Rows(b).Delete
        End If
    Next
End With
    End Sub

SoftAid

Sunnybat · « **Reactie #4 Gepost op:** 02 maart 2023, 20:21:06 »

@SoftAid

PAP werkt perfect, maar als ik nu zeg maar een andere tabblad toevoeg en dan EX of Test in Cel A zet en ik pas alles aan en voeg een moduke aan dan vraagt die naam
ook als ik de PAP aanpas
er zijn 4 soorten teksten die ik zou willen splitsen van 1 tabblad
maar dit is al

SoftAid · « **Reactie #5 Gepost op:** 02 maart 2023, 20:26:24 »

Sunnybat,

voeg een voorbeeldbestand toe met de extra tabbladen en de door jou bijgewerkte VBA code.

SoftAid

Sunnybat · « **Reactie #6 Gepost op:** 02 maart 2023, 20:54:07 »

@SoftAid

ben aan het stoeien geweest maar als je de macro run en hij vraag de naam en je geef aan wat je zoekt copyeerd hij heel de regels van blad 1
maar verders Toppie

Sunnybat · « **Reactie #7 Gepost op:** 02 maart 2023, 21:00:51 »

@SoftAid

Wil niet heel brutaal zijn, maar als je per tabblad de marco run en je geeft in wat je zoekt en hij geeft dat weer in de tabblad die je aan heb gemaakt dan heb je toch een top master code

SoftAid · « **Reactie #8 Gepost op:** 02 maart 2023, 21:07:30 »

Hallo Sunnybat,

Veel heb je niet aangepast of proberen aan te passen aan de macro, hoewel als je die code leest het toch redelijk gemakkelijk moet zijn (ik ben echt ook maar een amateurke, maar de aanpassing vind ik toch simpel.

Allee, hier komt ze:

Code: [Selecteer]

Sub PAP2()

    Worksheets("Blad1").Select
    x = InputBox("Welke naam zoek je?")
    Blad = InputBox("Naar welk tabblad wil je kopiëren?")  'Deze regel is toegevoegd 
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    For rij = 1 To lastrow
        If Cells(rij, 1) = x Then
            Sheets("Blad1").Cells(rij, 1).EntireRow.Copy Destination:=Sheets(Blad).Cells(rij, 1)
        End If
    Next

    'Lege rijen verwijderen in gekozen werkblad
    Dim b As Long
    Worksheets(Blad).Select
    With ActiveSheet

        For b = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
            If WorksheetFunction.CountA(.Rows(b)) = 0 Then
                ActiveSheet.Rows(b).Delete
            End If
        Next

    End With
End Sub

SoftAid

Sunnybat · « **Reactie #9 Gepost op:** 03 maart 2023, 07:29:10 »

@SoftAid

$_/-\o_$

Werkt Perfect en precies wat ik zou willen

Super bedankt

Help!

Menu

Hulp bij posten

Zoeken

Recente topics