macro in excel 2010

[meijerg56]

macro in excel 2010






ik had de vraag aangepast maar ik kan hem beter opnieuw vragen

ik zou graag een macro maken in een excel file die het volgende doet

na gefilterd te hebben op bv 1 zou ik een macro inzetten om het geheel te kopieren naar volgende blad met naam mix 1
als ik filter op 2 dan kopieren naar volgende blad net naam mix 2 enz
als er nog een keer gefilterd word op 1 met bv meerdere regels dan in de vorige filtering dan deze nieuwe aanhouden in blad mix 1

ik heb al geprobeerd met een macro in het voorbeeldje in de bijlage maar daar krijg ik een fout melding en ik weet ook niet
hoe ik dit kan wijzigen
ben een leek in VBA

wie kan mij helpen

gert

 

[VenA]

Probeer het zo eens

Sub VenA()
Application.ScreenUpdating = False
With Sheets(1)
    ar = .[b7].CurrentRegion.Resize(, 1)
    For j = 2 To UBound(ar)
        If InStr(1, c00, ar(j, 1)) = 0 Then c00 = c00 & "|" & ar(j, 1)
    Next j
    For j = 0 To UBound(Split(Mid(c00, 2), "|"))
        t = Split(Mid(c00, 2), "|")(j)
        .[b7].CurrentRegion.AutoFilter 1, t
        If IsError(Evaluate("Mix" & t & "!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Mix" & t
        .[b7].CurrentRegion.Copy Sheets("Mix" & t).[A1]
    Next j
    .[b7].CurrentRegion.AutoFilter
End With
End Sub

 

[meijerg56]

hallo VenA

bedankt dat je mij wil helpen met deze macro

als ik bv alle 1 ( enen) gefilterd heb kopiert deze macro toch alle 20 nummers in 20 nieuwe tabbladen
het filter in blad 1 is dan verdwenen

ik zou graag alleen de gefllterde nrs gekopiert hebben en het filter behouden
als er later nog een keer gefilterd word op bv nr 1 dan moet die mix 1 overschrijven

gert

 

[VenA]

Dan sloop je het gedeelte dat je niet nodig hebt er toch uit.

Sub VenA()
With Sheets(1)
    If IsError(Evaluate("Mix" & .[B8].Value & "!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Mix" & .[B8].Value
    .[B7].CurrentRegion.Copy Sheets("Mix" & .[B8].Value).[A1]
End With
End Sub

 

[meijerg56]

met deze macro selecteer hij alleen als ik filter op 1
dat gaat goed
alleen als ik later opnieuw filter op 1 met bv 1 regel minder vervangt hij mix 1 niet door deze

tevens filtering daarna op ander nrs doet het makro niets

dus eigenlijk wil ik indien mogelijk
als er gefilterd word op meerdere nr nv 1 5 8 9 dan moet de makro deze kopieren naar de desbetreffende mix

ik heb een voorbeeldje waar je kan zien dat ergefiterd word op meerdere nr maar hij alles in mix 1 zet

 

[VenA]

Wat heb je zelf zoal geprobeerd? Alle ingrediënten staan in #2

Probeer het zo eens.

Sub VenA()
Application.ScreenUpdating = False
With Sheets(1)
    For Each cl In .Columns(2).SpecialCells(12).SpecialCells(2, 1)
        If InStr(1, c00, cl.Value) = 0 Then c00 = c00 & "|" & cl.Value
    Next cl
    For j = 0 To UBound(Split(Mid(c00, 2), "|"))
        t = Split(Mid(c00, 2), "|")(j)
        .[b7].CurrentRegion.AutoFilter 1, t
        If IsError(Evaluate("Mix" & t & "!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Mix" & t
        Sheets("Mix" & t).Cells.Clear
        .[b7].CurrentRegion.Copy Sheets("Mix" & t).[A1]
    Next j
End With
End Sub

 

[meijerg56]

ik had zelf niets geprobeerd omdat Ik een nono ben in vba
maar het werkt

geweldig
bedankt


is opgelost

 

[VenA]

ik had zelf niets geprobeerd

Slechte eigenschap als je iets via VBA wil oplossen. Als het opgelost is kan je de vraag als opgelost markeren.

 

[meijerg56]

ik begin het een beetje te begrijpen
dus ik zal mijn leven verbeteren

nogmaals bedankt

 

[meijerg56]

toch nog een klein vraagje

ik heb de macro toegepast op mijn eigen file
het enigste wat nog niet goed gaat
bij het kopieren moeten de rijhoogte en kolom breedte hetzelfde zijn als het origineel
dit is nu niet het geval

 

[VenA]

Je kan toch een macro opnemen om het voor elkaar te krijgen?

Voor de rijhoogte Rows.RowHeight = 125 of wat de rijhoogte ook moet zijn
om kolommen de juiste breedte te geven ColumnWidth = 125 of wat de breedte ook moet zijn
of Columns.AutoFit voor de benodigde ruimte per kolom

 

[meijerg56]

ja maar waar zet ik dan tussen in de bestaande macro

sorry maar ik ben pas 1 week bezig met vba

gert

 

[VenA]

Je kan in de VB editor met <F8> door de code lopen. Je kan dan ook zien waar je op een bepaald moment bent en dan eventueel regels toevoegen/aanpassen.

Aangepast zal het zoiets worden.

Sub VenA()
Application.ScreenUpdating = False
With Sheets(1)
    For Each cl In .Columns(2).SpecialCells(12).SpecialCells(2, 1)
        If InStr(1, c00, cl.Value) = 0 Then c00 = c00 & "|" & cl.Value
    Next cl
    For j = 0 To UBound(Split(Mid(c00, 2), "|"))
        t = Split(Mid(c00, 2), "|")(j)
        .[b7].CurrentRegion.AutoFilter 1, t
        If IsError(Evaluate("Mix" & t & "!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Mix" & t
        With Sheets("Mix" & t)
            .Cells.Clear
            Sheets(1).[b7].CurrentRegion.Copy .[A1]
            .Rows.RowHeight = [COLOR="#FF0000"]255[/COLOR]
            .Columns.AutoFit
        End With
    Next j
End With
End Sub

Waarbij je de rijhoogte natuurlijk nog wel even moet aanpassen naar een beetje normale waarde. (meestal 12.75 of 15)

 

[meijerg56]

bedankt

ik ga er mee werken
weer een beetje geleerd

gert

 

[meijerg56]

Hallo VenL

ik ben zoals je kunt zien in mijn bijlage al wat aan het oefenen met de macro
ik heb geprobeerd om de macro uit te breiden met afdrukvoorbeeld verkleinen en afdruk grootte meteen goed aan te passen
windows zoom = 80 % om de tabbladen ook goed te zien op het scherm
de print afdruk op liggend gezet
en als laatste schaal = 51 % om goed uit te kunnen printen

echter de macro doet dit alles alleen op het laatste tabblad
hoe kan ik dit wijziging

ik heb trouwens de terug loop uit sommige columns gehaald anders deed de columns auto fit het beroerd

als laatste heb ik nog een vraag
kun je dmv een macro een foto die in een opmerking zit er uit kopieren
en naast de rij zetten die de opmerking bevat
alleen verplaatsing moet dan gerelateerd zijn aan de cellen ander gaat het verkeerd bij het filter

 

[VenA]

Dat de opmaak alleen op het laatste blad aangepast wordt komt doordat Next j op de verkeerde plaatst staat. Als je zoals al eerder geadviseerd met <F8> door de code loopt had je dat ook zelf kunnen zien

Hoe je een foto uit een opmerking haalt weet ik niet.

Het opnemen van een macro is een goede methode om te kijken hoe het een en ander in elkaar steekt. Daarna is het de sport om al het onnodige eruit te halen.
Volgens mij is dit voldoende

Sub VenA()
Application.ScreenUpdating = False
With Sheets(1)
    For Each cl In .Columns(2).SpecialCells(12).SpecialCells(2, 1)
        If InStr(1, c00, cl.Value) = 0 Then c00 = c00 & "|" & cl.Value
    Next cl
    For j = 0 To UBound(Split(Mid(c00, 2), "|"))
        t = Split(Mid(c00, 2), "|")(j)
        .[b5].CurrentRegion.AutoFilter 1, t
        If IsError(Evaluate("Mix" & t & "!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = "Mix" & t
        With Sheets("Mix" & t)
            .Cells.Clear
            Sheets(1).[b7].CurrentRegion.Copy .[A1]
            .Rows.RowHeight = 60
            .Columns.AutoFit
            With .PageSetup
                .Orientation = xlLandscape
                .Zoom = 50
                .PrintComments = xlPrintSheetEnd
            End With
            With ActiveWindow
                .View = xlPageBreakPreview
                .Zoom = 80
            End With
        End With
    Next j
End With
End Sub

 

[HSV]

Sub hsv()
 With Range("f6")
    .Comment.Visible = True
    .Comment.Shape.CopyPicture 1, 2
    .Comment.Visible = False
    .Offset(, 1).PasteSpecial
 End With
End Sub

 

[meijerg56]

Hallo venl

het werkt nu goed
bedankt hiervoor

2 vraagjes aan HSV

1 .als ik in f6 tm f61 allemaal opmerkingen hoe krijg ik deze er dan in een keer uit

2. als ik deze macro toepas op een file waarin de opmerking in e16 en in deze aanpas in de macro(f16 > e16)
dan krijg ik een foutmelding
Methode range van object global is mislukt

weet jij raad ??

 

[VenA]

In de code van HSV staat F6 hoe jij dan bij F16 komt is wel bijzonder. Wat je met f16 > e16 bedoelt mag ook wel wat meer uitleg.

Om met alle comments wat te doen kan je een lusje gebruiken. Voor kolom F

For Each cl In Columns(6).SpecialCells(-4144)
    code hsv
Next cl

Dit geeft wel een foutmelding als er geen comments in kolom F staan.

 

[meijerg56]

Goedmorgen

hoe zet ik dit laatste lusje in de code van hsv
ik heb een en ander geprobeerd maar het lukt niet



Met e61 bedoelde ik e6
als ik in column e6 een opmerking heb staan en ik verander de formule ook in e6 krijg ik deze foutmelding
Methode range van object global is mislukt