rij herhalen bij een cel waarde

[aqiltje]

Hij iedereen,
Heb namelijk vraagje, het gaat als volgende:

Ik heb een sheet met 5 columns met meerdere rijen.
Wat ik wil doen dat VBA loop schrijven zodat rij bij rij langs gaat en bij het laatste kolom naar waarde van cel kijkt,
Als de waarde meer dan 1 is dan gaat hij voor elke waarde die tegen komt (voorbeeld 5) hele rij onder elkaar met waarde 1, 5 keer kopiëren.
En die gaat voor alle rijen controleren.

Hoe zou deze loop er uit zien? Help graag.

 

[richard1970]

Bestu Agiltje,

Wij jouw welkom heetten op deze forum, maar wij niet goed zijn in Nederlandsch. Ik jouw fragu om fraag opniew stelle in choet Nederlandsch. Anders jij ook misschien bestandje meedoen sturen.

chroet,

Richard

 

[aqiltje]

Ja sorry voor mij NL
Ok dan anders formulieren….

Ik heb een sheet met 5 kolomen met meerdere rijen.
Ik wil een rij meerdere keer onder elkaar laten kopiëren.
Maar hoe?
Ik wil een VBA code (een loopje) zodat rij bij rij langs gaat en de waarde van het laatste cel bij elke rij leest.
Als het waarde meer dan 1 is ( bijvoorbeeld 2) dan moet hij hetzelfde rij gaan onder originele rij kopiëren. Als het waarde van het laatste kolom (het laatste cel van rij) is 5 of 8 is dan moet hij 5 of 8 keer hele rij onder elkaar kopiëren.
Is die nu duidelijker?

 

[Wigi]

Aqiltje

Het helpt als je eerst eens goed overdenkt wat je wil vragen. Eventueel schrijf je dat neer op een papiertje. En vraag je iemand in de buurt om het eens na te lezen.

Ik begrijp wat de macro moet doen, maar waarom trouwens nog een keertje: hier?

Heb je de macro recorder al eens uitgeprobeerd? Zie bij menu Extra, dan optie Macro's.

Op het forum hier staan ook massa's voorbeelden van lussen doorheen de rijen van een blad.

Wigi

 

[crash]

Welkom op Helpmij.

Graag de link "Breng dit bericht onder de aandacht van een moderator" gebruiken waarvoor deze is en niet om je vragen te stellen.

Als je op de link klikt staat in het volgende venster duidelijk omschreven waarvoor de link is:

Note: Via deze weg kan u een moderator berichten over een foutief geplaatst topic. Gebruik dit ook om SPAM, reclame berichten en probleem berichten (schelden, taalgebruik, etc) te melden.

 

[aqiltje]

sorry

oo, ok, sorry voor dat..... ben beginner

 

[aqiltje]

hier komt een voorbeeld.....
het is een .xls bestand. maar ik heb hem op txt gezet.
ik weet niet of per macro kan ,dan word een groote macro , ik weet niet of via VBA kan.
bij voorbeeld :
"ik ga hem op een nieuw sheet verplaatsen."

Sub newSheet()

Columns("A:E").Select

ArraySize = 0
For j = 1 To Columns.CountE(ActiveColumns.Range("E:E"))
If TypeName(Columns(j)) > 1 Then
Rows.Range(j).Select
ArraySize = ArraySize + 1
Selection.Copy

Cells.Select
ActiveRows.Paste

End If
Next

Selection.Copy
Worksheets.Add
Cells.Select
ActiveSheet.Paste

End Sub

 

[aqiltje]

hier komt een voorbeeld.....


"ik ga hem op een nieuw sheet verplaatsen."

Sub newSheet()

Columns("A:E").Select

ArraySize = 0
For j = 1 To Columns.CountE(ActiveColumns.Range("E:E"))
If TypeName(Columns(j)) > 1 Then
Rows.Range(j).Select
ArraySize = ArraySize + 1
Selection.Copy

Cells.Select
ActiveRows.Paste

End If
Next

Selection.Copy
Worksheets.Add
Cells.Select
ActiveSheet.Paste

End Sub

 

[aqiltje]

kan niemand helpen?

my vraag staat al paar dagen, kan niemand my helpen.
kijk ook naar de bijlage als voorbeeld.

 

[Wigi]

Hoi

voeg een nieuw blad in en voer deze code uit:

Sub newSheet()

    Dim r As Range
    
    With Sheets("dieetkaartjes2")
        
        .Cells(1, 1).Resize(1, 5).Copy Cells(1, 1)
        
        For Each r In .Range("E2", .Range("E" & Rows.Count).End(xlUp))
            
            If IsNumeric(r.Value) Then
                
                If r.Value > 0 Then
                    
                    .Cells(r.Row, 1).Resize(1, 5).Copy Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(r.Value)
                    
                End If
                
            End If
            
        Next r
        
        'replace with 1's
        Range("E2", Range("E" & Rows.Count).End(xlUp)).Value = 1
        
    End With

End Sub

Wigi

 

[aqiltje]

bedankt Wigi

bedankt wigi, dat was leerzaam. dit heeft me veel gehulpen.:thumb:

 

[Wigi]

Dan mag de vraag nog op opgelost komen aub.