bepaalde regels / kolommen kopieren

[Jhon van der Bo]

Als men op de knop 'status' klikt dan verschijnt er een venster met daarin 2 keuze optie's >> status 0 / 50 en status 75.
De bedoeling is nu dat als men kiest voor 'status 0 / 50' de alle REGELS worden gekopieerd waar in kolom 'AE' de tekst 0 of 25 of 50 voorkomt én dan moeten alleen de kolommen C, I, Q, S, T, W, AA en AW worden gekopieerd naar een nieuw workbook. Dit geldt ook voor als men kiest voor 'status 75'.

Deze kolommen kopieren naar een nieuw workbook is geen probleem, maar het gaat mij om die die waardes in kolom 'AE'. Hier moet ik b.v. een macro of een formule voor hebben.

 

[Jhon van der Bo]

Bijlage

 

[Ingrid B]

Private Sub CmdWeergeven_Click()
If Not (OptionButton1.Value Or OptionButton2.Value) Then
  MsgBox "Geen selectie gemaakt"
Else
  weergeven
End If
Unload Me
End Sub

Sub weergeven()
Dim r As Long, laatste As Long
  Range("C:C,I:I,Q:Q,S:S,T:T,W:W,AA:AA,AE:AE").Copy
  Workbooks.Add
  ActiveSheet.Paste
  Range("A1").Select
  laatste = Range("H65536").End(xlUp).Row
  If OptionButton1.Value Then
    For r = laatste To 3 Step -1
      If Not (Cells(r, 8) <= 50) Then
        Rows(r).Delete
      End If
    Next r
  Else
    For r = laatste To 3 Step -1
      If Cells(r, 8) <> 75 Then
        Rows(r).Delete
      End If
    Next r
  End If
End Sub

 

[Jhon van der Bo]

Ingrid,

Ik heb de 'Sub weergeven' in een module geplaatst en 'Private Sub CmdWeergeven_Click()' in het userform 'Overz8DStatus'.
Ongeacht welke optionbutton in aanvink, als ik op weergeven klik dan krijg ik een foutmelding bij 'If OptionButton1.Value Then'.
Heb ik nu de code verkeerd geplaatst?

 

[Ingrid B]

Zet beide macro's eens in de UserForm-code. Als je een dergelijke code in een module plaatst dan maak je het jezelf alleen maar moeilijker.

 

[Jhon van der Bo]

WERKT PERFECT :thumb:

Ingrid bedankt

 

[Jhon van der Bo]

Ben nu op mijn werk en nu krijg ik hier een foutmelding bij het runnen van deze macro.
Bij 'Sub Weergeven' is de tekst 'If Cells(r, 8) <> 75 Then' geel gedrukt.

Thuis werkte dit perfect >> Win XP, Office 2000
Werk >> Win NT, Office '97 SR-2

 

[jzeedijk]

Hoi Jhon,

Eerdere opmerking vergeten.

Cells (r,8) is leeg. Dit kun je voorkomen door:

For r = laatste To 3 Step -1
If isempty(Cells(r,8)) then k=0 Else k=Cells(r,8)

Als je lege regels wil bewaren dan moet k 50 of 75 worden.
En Cells(r,8) in de code te vervangen door k
Let wel: De For Next regel staat er 2 x.

Jeroen

 

[Jhon van der Bo]

Hoi Jeroen,

Het gekke is dat ik deze afgelopen weekend thuis heb getest en daar werkte alles goed.
Deze zelfde sheet heb ik nu op mijn werk en hier krijg ik de foutmelding.
Zie de bijlage.

 

[jzeedijk]

Hoi Jhon,

Bij mij werkt ie ook goed.

Ik vermoed dat:
laatste = Range("H65536").End(xlUp).Row
geen geldige functie is in Excel 97.

Voor mij is duidelijk dat Laatste niet gevuld wordt waardoor de foutmelding ontstaat.

Je kunt dit omzeilen door:
...
Range("A1").Select
Set k = Range("AE3:AE9999")
Laatste= WorksheetFunction.CountA(k) + 2
....

Jeroen

 

[Jhon van der Bo]

Heb dit even getest en krijg geen foutmelding meer. Maar hij heeft de overtollige regels niet verwijdert.

De persoon die deze database gaat gebruiken heeft Excel 2002. Ik heb deze sheet naar hem gemaild en bij hem werkt deze goed. Ga er dan ook vanuit dat het aan de Excel 97 ligt.

Verder is het geen probleem >> krijg op mijn werk achter +/- 3Mnd ook Excel 2002.

Is het niet mogelijk om een bepaalde Add-In van Excel 2002 te gebruiken voor Excel '97, zonder dat mijn versie corrupt raakt of helemaal niet meer werkt?

 

[Ingrid B]

Excel 97 heeft blijkbaar problemen als er een tekstwaarde in de cel staat. Volgende macro zou wel moeten werken:

Sub weergeven()
Dim r As Long, laatste As Long
  Range("C:C,I:I,Q:Q,S:S,T:T,W:W,AA:AA,AE:AE").Copy
  Workbooks.Add
  ActiveSheet.Paste
  Range("A1").Select
  laatste = Range("H65536").End(xlUp).Row
  If OptionButton1.Value Then
    For r = laatste To 3 Step -1
      If IsNumeric(Cells(r, 8)) Then
        If Not (Cells(r, 8) <= 50) Then Rows(r).Delete
      Else
        Rows(r).Delete
      End If
    Next r
  Else
    For r = laatste To 3 Step -1
      If IsNumeric(Cells(r, 8)) Then
        If Cells(r, 8) <> 75 Then Rows(r).Delete
      Else
        Rows(r).Delete
      End If
    Next r
  End If
End Sub

 

[Jhon van der Bo]

Ingrid,

Deze code werkt in ieder geval wel op Excel 2000, deze heb ik thuis uitgeprobeerd. Morgen zal ik deze op Excel 97 proberen >> heb er alle vertrouwen in :thumb:

 

[Ingrid B]

Ik heb het op een Excel 97 uitgetest, dus volgens mij zou het zo moeten werken.

 

[Jhon van der Bo]

Heb deze getest en ....ja hoor, werkt correct.

Ingrid bedankt :thumb: