uitbreiding van macro

[Logistiek]

onlangs heb ik van het helpmij form een marco gehaald en die werk opzich prima maar als je en nog een keer op klikt gaat hij voor de 2e keer allers weer in vullen is hier iets tegen toe doen ???

Sub macro1 ()
Dim rng As Range
Dim y As Long

With Sheets(1)
For Each rng In .Range("D247")
If rng = "x" Then
y = Sheets(5).Cells(Rows.Count, "B").End(xlUp).Row + 1
rng.Offset(, -3).Resize(, 3).Copy
Sheets(5).Range("B" & y).PasteSpecial xlPasteValues
End If
Next rng
Application.CutCopyMode = False
End With

end sub

 

[trucker10]

onlangs heb ik van het helpmij form een marco gehaald en die werk opzich prima maar als je en nog een keer op klikt gaat hij voor de 2e keer allers weer in vullen is hier iets tegen toe doen ???

Stel dat je gewoon dit erbij zou doen

Sub macro1()
    Dim rng    As Range
    Dim y      As Long
    [COLOR="Lime"]Application.ScreenUpdating = False[/COLOR] ' om het beeld stil te houden 
    With Sheets(1)
        For Each rng In .Range("D2:D47")
            If rng = "x" Then
                y = Sheets(5).Cells(Rows.Count, "B").End(xlUp).Row + 1
                rng.Offset(, -3).Resize(, 3).Copy
                Sheets(5).Range("B" & y).PasteSpecial xlPasteValues
            End If
        Next rng
        Application.CutCopyMode = False
    End With
         [COLOR="Red"] [D2:D47].ClearContents[/COLOR]
        [COLOR="lime"]Application.ScreenUpdating = True [/COLOR]
End Sub

 

[Logistiek]

nee dit is niet echt de oplossing
hij gooit denk het beeld te snel stil waardoor niet alles wordt weer gegeven

is er niet iets waardoor de macro kijk of er al gegevens staan waar hij ze weg moet zetten en als dat dan zo is er een melding komt of zo "maak eerst het werkblad leeg voor je door gaat "

 

[trucker10]

nee dit is niet echt de oplossing
hij gooit denk het beeld te snel stil waardoor niet alles wordt weer gegeven

Het beeld mag stil gezet worden de macro doet zijn werk verder

is er niet iets waardoor de macro kijk of er al gegevens staan waar hij ze weg moet zetten en als dat dan zo is er een melding komt of zo "maak eerst het werkblad leeg voor je door gaat "

Wat ga je dan doen als je toch na x aantal uren /dagen toch nog eens hetzelfde moet overzetten ? het staat er al
Of is het de bedoeling dat hij het blad 5 leegmaakt voor je de macro laat lopen ?

 

[trucker10]

Dan iets zoals dat hier , blad 5 leeg

Sub macro1()
    Dim rng    As Range
    Dim y      As Long
    Application.ScreenUpdating = False ' om het beeld stil te houden
   [COLOR="Red"] Sheets("Blad5").Range("B1:D200").ClearContents[/COLOR]
    With Sheets(1)
        For Each rng In .Range("D2:D47")
            If rng = "x" Then
                y = Sheets(5).Cells(Rows.Count, "B").End(xlUp).Row + 1
                rng.Offset(, -3).Resize(, 3).Copy
                Sheets(5).Range("B" & y).PasteSpecial xlPasteValues
            End If
        Next rng
        Application.CutCopyMode = False
    End With
        
        Application.ScreenUpdating = True
End Sub

 

[snb]

Sub macro1 ()
  sq=Sheets(1).Range("D2:F47")
  for j= 1 to ubound(sq)
    if sq(j,1)<>"x" then sq(j,1)=""
  next
  With Sheets(5)
     .Cells(Rows.Count, 2).End(xlUp).resize(ubound(sq),ubound(sq,2))=sq
     .columns(2).specialcells(xlcelltypeblanks).entirerow.delete
  End With
End Sub

 

[Logistiek]

Sheets("Blad5").Range("B1200").ClearContents
met deze regel er tussen (aan gepast dan wel ) werk het voor mij prima
dus bedankt allemaal weer :thumb:

 

[trucker10]

Sheets("Blad5").Range("B1200").ClearContents
met deze regel er tussen (aan gepast dan wel ) werk het voor mij prima
dus bedankt allemaal weer :thumb:

Ik had de range vrij groot gepakt

 

[snb]

Sheets("Blad5").usedrange.columns("B:D").ClearContents