• 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.

Macro verwijdert kolommen niet

  • Onderwerp starter Onderwerp starter MMV
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

MMV

Gebruiker
Lid geworden
6 mei 2008
Berichten
111
Beste,

Onderstaande macro verwijdert mijn geselecteerde kolommen niet.
Wanneer ik via de VBA editor de macro nogmaals run verwijdert deze wel de kolommen.

Hoe kan dit, en hoe kan ik dit oplossen?

Code:
If MsgBox("Wilt u de actielijst genereren?", vbYesNo) = vbYes Then
'Copy Actielijst
    Dim WS As Worksheet
    Dim WSNew As Worksheet
    Dim rng As Range
    Dim rng2 As Range
    Dim cell As Range
    

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    
    
    DoEvents
   
  
    Application.DisplayAlerts = False
    Sheets("Copy Actionlist").Delete
    Application.DisplayAlerts = True
  
  
    Set WSNew = Worksheets.Add
    WSNew.Name = "Copy Actionlist"
    Sheets("Copy Actionlist").Move After:=Sheets("Actionlist")
  
    'Delete the sheet MyFilterResult if it exists
    'On Error Resume Next
    'Application.DisplayAlerts = False
    'Sheets("Copy Actionlist").Delete
    'Application.DisplayAlerts = True
    'On Error GoTo 0
    Sheets("Copy Actionlist").Select
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Columns("A:AD").Select
    Selection.ClearContents
    

    'Add a new worksheet to copy the filter results in
    Sheets("Actionlist").Select
    Range("A1:AB10001").Select
    Selection.Copy
    Sheets("Copy Actionlist").Select
    Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteColumnWidths
    Application.CutCopyMode = False
            
    'Hyperlink toevoegen aan referentiekolom
    Range("H2:H2001").Select

    For Each cell In Intersect(Selection, _
    Selection.SpecialCells(xlConstants, xlTextValues))

    With Worksheets(1)
    .Hyperlinks.Add anchor:=cell, _
    Address:="http://www.test.nl/" + cell.Value, _
    ScreenTip:=cell.Value, _
    TextToDisplay:=cell.Value
    End With
    Next cell
                      
                      
                      
    'Overtollige kolommen verwijderen
    Sheets("Copy Actionlist").Range("A1").Select
[COLOR="magenta"]    Range("A:A,C:C,E:E,F:F,L:L,S:S,T:T,U:U,V:V,W:W,AB:AB").Delete[/COLOR]
 
 
 
       
Sheets("Reporting").Select


Else
  
End If

End Sub
 
MMV,

Heb je al eens geprobeerd om met F8 door de code te lopen?
Zo kun je zien wat er gebeurd en misschien dat je dan de oplossing weet.
 
Ja logischerwijs heb ik dit gedaan.
Hier loopt de macro goed. Echter, wanneer ik deze via een knop aanroep loopt de macro vast op de paars aangegeven regel.
 
Je kunt volgens mij geen kolommen verwijderen maar wel verbergen.
Range("A:A,C:C,E:E,F:F,L:L,S:S,T:T,U:U,V:V,W:W,AB:AB").EntireColumn.Hidden = True
 
Gelukt, middels de volgende aanpassing is dit gewoon te realiseren. Toch bedankt!

Code:
[A:A,C:C,E:E,F:F,L:L,S:S,T:T,U:U,V:V,W:W,AB:AB].Delete
 
Fijn dat het gelukt is.

Deze maakt de kolommen leeg.
[A:A,C:C,E:E,F:F,L:L,S:S,T:T,U:U,V:V,W:W,AB:AB].ClearContents

Zet de vraag dan even als opgelost, dank je :thumb:
 
MMV,

haal ook de onnodige Select's uit de code. Bvb.

Code:
Sheets("Actionlist").Select
    Range("A1:AB10001").Select
    Selection.Copy

wordt:


Code:
Sheets("Actionlist").Range("A1:AB10001").Copy

of zelfs:

Code:
[Actionlist!A1:AB10001].Copy
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan