• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Excel vba kopieer vorige rij in gegevensreeks naar nieuw blad op basis van bep.waarde

Status
Niet open voor verdere reacties.
4

4011richard

Gebruiker
Lid geworden
25 feb 2019
Berichten
9
Hallo iedereen,

ik heb een gegevensblad van kolom A tot H op sheet 1
Ik wil een bepaalde waarde zoeken in deze data reeks ,bijvoorbeeld waarde 33, en dan de hele rij kopiëren naar sheet 2
Dit lukt mij met deze macro

Sub verplaats rij op waarde 33()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Sheet1").Range("B1:H" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "33" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub

Maar nu wil ik hetzelfde (zoeken naar de waarde 33) en dan de vorige rij kopiëren naar sheet 2 en dat lukt me niet.
Ik ben niet goed thuis in vba maar wil wel leren.
Kan iemand me een hint geven of kernwoord dat ik kan google-len

Ik denk dat het probleem zit in de regel
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)

Ik heb al K-1 geprobeerd
Ik denk dat ik ergens een -1 moet zetten
previousRow bestaat niet , dacht ik

Iemand een hint?
 
Een hint wel.
Klik eens op de link in m'n handtekening ;)
 
Er zijn meerder kenwoorden. filter en/of geavanceerd.
 
@edmoor
Bedankt voor je snelle reactie.
Ik heb geklikt op je link en volgens mij is er maar 1 ding dat in aanmerking komt en dat zijn de tags voor de macro

Code: 
Sub verplaats rij op waarde 33()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Sheet1").Range("B1:H" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "33" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub

Bij deze.

@VenA
dank je voor je mail
ik had al geexperimenteerd met de filters maar weet niet goed hoe dit in macro te gieten.
Ik zal vanavond opnieuw proberen
 
In het linkje zal ongetwijfeld ook iets over een voorbeeldbestand staan.
 
Gisterenavond geprobeerd met filters en geavanceerd maar geraak er niet uit.

Bij deze ook een bestandje als voorbeeld (in de hoop dat ik alle hints begrepen heb:)

Het bestand in bijlage laat gegevens zien.
Ik wil bijvoorbeeld in de gegevens in sheet 1 telkens het getal 10 vinden en dan de rij boven het getal 10 telkens kopieren naar sheet 2

Alvast bedankt voor een hint
 

Bijlagen

Mij lijkt sheet2 niet te kloppen met de vraag. Hoe moeten 5 kolommen aangevuld worden tot 7 kolommen en met data die niet te vinden is? Werk je nog met een versie van voor XL-2017? En werk je met een MAC? Bestanden kan je ook zonder te zippen hier uploaden.

Edit Nog een vraag; Wat moet er gebeuren als er in de eerste rij ook 10 voorkomt? Gebruik je geen kolomkoppen?

Om ergens te beginnen
Code: 
Sub VenA()
  Dim j As Long, jj As Long, t As Long, ar, ar1
    ar = Sheets("sheet1").Cells(1).CurrentRegion
    t = UBound(ar, 2)
    ReDim ar1(t, 0)
    For j = 2 To UBound(ar)
      For jj = 1 To t
        If ar(j, jj) = 10 Then
          For jjj = 1 To t
            ar1(jjj - 1, UBound(ar1, 2)) = ar(j - 1, jjj)
          Next jjj
          ReDim Preserve ar1(t, UBound(ar1, 2) + 1)
        End If
      Next jj
    Next j
    Sheets("sheet2").Cells(1, 10).Resize(UBound(ar1, 2), t) = Application.Transpose(ar1)
End Sub
 
Laatst bewerkt:
Beste VenA,

uw quote "om ergens te beginnen" is redelijk bescheiden, wat dit is net wat ik moet hebben!
Het is kant en klaar, en mijn dank hiervoor is bijzonder groot.

Om nog even te antwoorden op je vragen:
Ik werk op een mac en met office 365 maar mijn bestand was 25mb (?) groot dus dat kreeg ik niet geupload.
Ik heb wat proberen te strippen in kolommen, hetgeen verklaart dat op de tweede sheet meerdere kolommen stonden die ik was vergeten.

Als ik zipte kwam ik nog tot een bestand van 13 mb, en ik zag dat ik maar 1,95 kon uploaden.

Als oplossing heb ik naar een lagere versie gesaved en gezipt en toen ging het wel.


Toch nog een klein vraagje: kan ik in plaats van de waarde "10" te zoeken ,
de waarde van cel "J1" zoeken?
 
Je kan een bestand dat te groot is beter als .xlsb opslaan. (Is bij mij maar 18kb.)
Code: 
If ar(j, jj) = Sheets("sheet1").Cells(1, 10).Value Then
 
Dank je wel VenA!!

Werkt perfect.

Als ik nu verder durf te filosoferen en de zoekwaarde in j1 uitbreid met een volgende zoekwaarde in J2 en dan verder tot J10.
En de resultaten van deze zoekwaarden tevoorschijn laat komen in sheet 1 tot sheet 11 dan heb ik maar
1 druk op de macro nodig. (als alles correct is wat ik denk)

ps
inderdaad slechts 20 mb, wist ik niet

ps
heb zelf een beetje geprutst in mijn kinderschoenen

Code: 
Sub VenA_test()
  Dim j As Long, jj As Long, t As Long, ar, ar1, test
    ar = Sheets("sheet1").Cells(1).CurrentRegion
    test = Sheets("sheet1").Cells(1, 10).Value
    test_sheet = Sheets("sheet1").Cells(1, 11).Value
    t = UBound(ar, 2)
    ReDim ar1(t, 0)
    For j = 2 To UBound(ar)
      For jj = 1 To t
        'If ar(j, jj) = 11 Then
        If ar(j, jj) = test Then
          For jjj = 1 To t
            ar1(jjj - 1, UBound(ar1, 2)) = ar(j - 1, jjj)
          Next jjj
          ReDim Preserve ar1(t, UBound(ar1, 2) + 1)
        End If
      Next jj
    Next j
    Sheets(test_sheet).Cells(1, 1).Resize(UBound(ar1, 2), t) = Application.Transpose(ar1)
End Sub
 

Bijlagen

Welk nut heeft het om alle data te verspreiden over meerde tabjes? Je krijgt allerlei dubbelingen. Is dit voorbeeld wel representatief?

Edit Nog een vraag; Wat moet er gebeuren als er in de eerste rij ook 10 voorkomt? Gebruik je geen kolomkoppen?
Klik om te vergroten...
Heb ik geen antwoord op gezien.

Zelf zou ik een extra kolom gebruiken om te filteren en eventueel een eenvoudige macro koppelen. Kies maar iets in I1 en je hebt ook de informatie die je zoekt.

Slechts 1 regel code nodig.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$I$1" Then Cells(1).CurrentRegion.AutoFilter 6, IIf(Target.Value = "", "<>", 1)
End Sub
 

Bijlagen

Hallo VenA,

betref de kolomkoppen: ja die gebruik ik wel maar had ze niet opgenomen in het voorbeeld.
Als de gezochte waarde in de eerste rij zit, worden deze koppen overgenomen en anders niet.
Daar moet ik wat op letten.

Je voorstel van oplossing heb ik getest en is inderdaad de oplossing.
Ik wil je nog bedanken voor alles en wat mij betreft mag deze topic gesloten worden
 
Graag gedaan. Voor de volgende keer, plaats een representatief voorbeeldbestand. Alleen jij of een moderator kan de vraag op opgelost zetten.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan