Rijen selecteren in een tabel en verwijderen

Status
Niet open voor verdere reacties.
Beste HSV,

Inmiddels ben ik er bijna een dag mee bezig, maar kom door gebrek aan kennis niet verder.
De macro struikelt even voor de module beginnend met Sub hsv().

Ik weet niet waar het aan ligt en heb de hele macro maar ingesloten.
Wil je er nog een keertje naar kijken?

Code:
Option Explicit
Dim ps As String

Sub BestandOpslaan()
'Huidig bestand opslaan
Dim ws As Worksheet

'Huidig bestand opslaan
With Blad11
ps = InputBox("Huidige bestand wordt beveiligd opgeslagen. Voer aub een wachtwoord in.", vbOKCancel)
For Each ws In Sheets
ws.Protect ps
Next ws

ThisWorkbook.SaveAs .Range("J2") & "\" & .Range("F1") & "\" & .Range("J3") & "-" & .Range("F1"), 52

'Bestand opslaan onder een nieuw boekjaar
ThisWorkbook.SaveAs .Range("J2") & "\" & .Range("J4") & "\" & .Range("J3") & "-" & .Range("J4"), 52
 .Unprotect
 End With
End Sub

'Tabel Boekingen filteren en rijen verwijderen
Sub hsv()
With Blad5
  .Unprotect ps
Application.DisplayAlerts = False
     With .Cells(1).CurrentRegion
        .AutoFilter 7, Array("ABNA Bank", "Kas", "Memoriaal"), 7
        .Offset(1).Delete
        .AutoFilter
    End With
  .Protect ps
 End With
End Sub

'Kalender verplaatsen en aanpassen voor nieuwe jaar
 Sub M_snb()
 Blad8.Select
    sn = Range("A2:B4")
    Blad8.ListObjects(1).ListRows(1).Range.Resize(DateSerial(Year(sn(3, 1)), 12, 31) - sn(3, 1) + 1).Delete
    Blad8.Cells(4, 1).Resize(DateSerial(sn(1, 2) + 1, 12, 31) - DateSerial(sn(1, 2), 1, 0)) = [index(text(date(B2,1,row(1:731)),"yyyy-mm-dd"),)]
    End With
 ActiveWorkbook.Save
End Sub
 
Waarschijnlijk bij.....
Code:
 .Unprotect


....als jij het niet zeker weet.

Verander het in:

Code:
 .Unprotect ps
 
Beste VenA en HSV,

Ik blijf maar heen en weer prutsen, zonder resultaat.
Kan het aan de versie van Excel liggen? Ik heb 2016.

Bijgaand nog een andere poging. De macro struikelt op het rode gedeelte.

Code:
Option Explicit
Dim ps As String

Sub BestandOpslaan()
'Huidig bestand opslaan
Dim ws As Worksheet

'Huidig bestand opslaan
With Blad11
ps = InputBox("Huidige bestand wordt beveiligd opgeslagen. Voer aub een wachtwoord in.", vbOKCancel)
For Each ws In Sheets
ws.Protect ps
Next ws

ThisWorkbook.SaveAs .Range("J2") & "\" & .Range("F1") & "\" & .Range("J3") & "-" & .Range("F1"), 52
End With

'Bestand opslaan onder een nieuw boekjaar
ThisWorkbook.SaveAs .Range("J2") & "\" & .Range("J4") & "\" & .Range("J3") & "-" & .Range("J4"), 52
ps = InputBox("Beveiliging ongedaan maken in het nieuwe bestand. Voer aub een wachtwoord in.", vbOKCancel)
For Each ws In Sheets
ws.Unprotect ps
Next ws
End Sub

'Tabel Boekingen filteren en rijen verwijderen
Sub hsv()
With Blad5
Application.DisplayAlerts = False
     [COLOR="#FF0000"]With .Cells(1).CurrentRegion[/COLOR]
        .AutoFilter 7, Array("ABNA Bank", "Kas", "Memoriaal"), 7
        .Offset(1).Delete
        .AutoFilter
    End With
 End With
End Sub

'Kalender verplaatsen en aanpassen voor nieuwe jaar
 Sub M_snb()
 Blad8.Select
    sn = Range("A2:B4")
    Blad8.ListObjects(1).ListRows(1).Range.Resize(DateSerial(Year(sn(3, 1)), 12, 31) - sn(3, 1) + 1).Delete
    Blad8.Cells(4, 1).Resize(DateSerial(sn(1, 2) + 1, 12, 31) - DateSerial(sn(1, 2), 1, 0)) = [index(text(date(B2,1,row(1:731)),"yyyy-mm-dd"),)]
    End With
 ActiveWorkbook.Save
End Sub
 
Laatst bewerkt:
Wat voor melding?

Code:
'Tabel Boekingen filteren en rijen verwijderen
Sub hsv()
Application.DisplayAlerts = False
     With Blad5.Cells(1).CurrentRegion
        .AutoFilter 7, Array("ABNA Bank", "Kas", "Memoriaal"), 7
        .Offset(1).Delete
        .AutoFilter
    End With
End Sub
 
Beste HSV,

Allereerst mijn excuses dat er door mij twee verzoeken zijn geplaatst in dit forum.
Het wordt er daardoor allemaal niet duidelijker van.
Ik weet niet hoe ik één van de onderwerpen kan verwijderen.

Terugkomend op dit bericht. Ik heb de door jou opgegeven code toegepast, maar ipv de gewenste rijen uit de tabel te verwijderen, wordt er een rij (rij 7) uit het werkblad verwijderd.
Wil je daar nog eens naar kijken?

mvg,
 
Laatst bewerkt door een moderator:
Je zal vast iets aan de code veranderen.
Eerst opent het blad7, en nu verwijderd het rij 7.
Het tweede zou kunnen als daar de criteria inzit en dat is de bedoeling.

Ik heb het een aantal keren voorgedaan en blijf bij de code die werkt.
Het geplaatste bestand is vast niet het bestand waar jij mee werkt en de gegevens vast niet in cel A1 beginnen.

Succes ermee.

Ps.
De codes in de bestanden die ik plaatste zijn correct.
Voor een ieder met hetzelfde probleem kunnen die gebruiken.
 
Beste HSV,

Dank voor je reactie. Ben ik erg blij mee.
Maar ik heb het diverse keren getest, zonder resultaat.
Het maakt mij een beetje radeloos want ik zie niet waar de fout zit.
Nogmaals heb ik een uittreksel van het bestand geupload.
De cellen komen overeen met het originele bestand.
De macro wordt deel uitgevoerd en stokt bij het verwijderen van de niet over te nemen rijen.

Wat doe ik verkeerd?

mvg,


Code:
Sub BestandOpslaan()
'Huidig bestand opslaan
ps = InputBox("Het huidige bestand wordt beveiligd. Voer een wachtwoord in.", vbOKCancel)
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:=ps
Next ws
ActiveWorkbook.Save

'Bestand opslaan onder een nieuw boekjaar
'Eerst kijken of de map aanwezig is
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(Range("J2") & "\" & Range("J4")) Then

'Maak een map
MkDir Range("J2") & "\" & Range("J4")
End If
ActiveWorkbook.SaveAs Range("J2") & "\" & Range("J4") & "\" & Range("J3") & "-" & Range("J4")
ActiveWorkbook.Unprotect ps
End Sub

'Tabel Boekingen filteren en rijen verwijderen
Sub BoekingenOpschonen()
Blad5.Select
Application.ScreenUpdating = False
For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If Range("G" & i) = "ABNA bank" Then
Rows(i).Delete
End If
If Range("G" & i) = "Kas" Then
Rows(i).Delete
End If
If Range("G" & i) = "Memoriaal" Then
Rows(i).Delete
End If
Application.ScreenUpdating = True
Next
End Sub

'Kalender verplaatsen en aanpassen voor nieuwe jaar
Sub KalenderAanpassen()
Blad8.Select
ActiveSheet.Unprotect ps
sn = Range("A2:B4")
Blad8.ListObjects(1).ListRows(1).Range.Resize(DateSerial(Year(sn(3, 1)), 12, 31) - sn(3, 1) + 1).Delete
Blad8.Cells(4, 1).Resize(DateSerial(sn(1, 2) + 1, 12, 31) - DateSerial(sn(1, 2), 1, 0)) = [index(text(date(B2,1,row(1:731)),"yyyy-mm-dd"),)]
ActiveWorkbook.Save
End Sub
 

Bijlagen

  • Nieuw boekjaar.xlsb
    335,2 KB · Weergaven: 30
Laatst bewerkt door een moderator:
En je paswoord is ...
Code:
Sub BoekingenOpschonen()
   Blad5.Select
   ActiveSheet.Unprotect "mijnPaswoord"
   Application.ScreenUpdating = False
   For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
      Select Case Range("G" & i).Value
         Case "ABNA bank", "Kas", "Memoriaal"
            Rows(i).Delete
      End Select
   Next
   Application.ScreenUpdating = True
   ActiveSheet.Protect "mijnPaswoord"

End Sub
Gemakkelijkheidshalve had je, om problemen met hoofdletters/kleine letters te vermijden, ook
* ofwel bovenin de module "Option Compare Text" kunnen toevoegen
* ofwel door eerst om te zetten naar kleine letters via "lcase( Range("G" & i).Value)"
iets kunnen doen

Anders ook niet de vlotste manier om een bestand op te schonen, maar ik ga geen 48 berichtjes doorlezen, maar op het eerste zicht, voeg een lege rij tussen rij 14 en 15, rij 15 wordt dan rij 16 en werk dan met range("A16").currentregion.
Maak desnoods voor esthetische redenen dan rij 15 onzichtbaar ...
 
Laatst bewerkt:
Beste Cow18 en anderen,

Dank voor jullie reacties.

Zoals ik al eerder aangaf, ben ik totaal niet thuis in VBA.
Heb ook al van alles geprobeerd.
Uren en dagen er in gestopt. Soms ging iets goed en daarna weer niet. Dat frustreert.
Bovendien is dat niet prettig voor jullie als helpers.
Ik weet niet hoe ik hier uit kan komen. Voorlopig stop ik er maar even mee.

mvg,
 
Laatst bewerkt door een moderator:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan