cel waarden kopieren zonder opmaak

Status
Niet open voor verdere reacties.
B

Bjorkie

Gebruiker
Lid geworden
12 sep 2017
Berichten
147
Hey allen:
ik gebruik volgend script om bepaalde waarden te kopieren in verkorte vorm.
nu wil ik dat de celopmaak NIET mee gekoipieerd zal worden.
iemand een idee waar ik iets aanpassen kan?

Code: 
Sub Module10()
    Range("A21:K27").AutoFilter
    Worksheets("Sheet1").Range("A20:K20").AutoFilter
    ActiveSheet.Range("$A$20:$K$27").AutoFilter Field:=11, Criteria1:=">0", _
        Operator:=xlAnd
    Worksheets("Sheet1").Range("A21:A27").Copy Sheets("Sheet1").Range("AJ28")
    Worksheets("Sheet1").Range("B21:B27").Copy Sheets("Sheet1").Range("AL28")
    Worksheets("Sheet1").Range("K21:K27").Copy Sheets("Sheet1").Range("AK28")
    Range("A20:J21").AutoFilter
   
End Sub

een verkorte versie mag ook steeds aangegeven worden.
ik heb enkel de waarden van kolom A - B - K nodig.
in Kolom K, moet ik eerst een filter uitvoeren, waarbij de waarden groter moeten zijn dan 0.
ik heb dus enkel de velden nodig, waar de cel in kolomK geen à is.

(eerst proberen zonder voorbeeld bestandje :) )
 
Ik heb iets gevonden:
Code: 
Sub Create_Recorderlist()
    Range("A21:K27").AutoFilter
    Worksheets("Recorders").Range("A20:K20").AutoFilter
    ActiveSheet.Range("$A$20:$K$27").AutoFilter Field:=11, Criteria1:=">0", _
        Operator:=xlAnd
    Worksheets("Recorders").Range("A21:A27").Copy
    Sheets("Recorders").Range("AJ28").PasteSpecial xlPasteValues
    Worksheets("Recorders").Range("B21:B27").Copy
    Sheets("Recorders").Range("AL28").PasteSpecial xlPasteValues
    Worksheets("Recorders").Range("K21:K27").Copy
    Sheets("Recorders").Range("AK28").PasteSpecial xlPasteValues
    Range("A20:J21").AutoFilter
   End Sub

deze kan ik nog verkorten naar:
Code: 
Sub Create_Recorderlist()
    Range("A21:K27").AutoFilter
    Range("A20:K20").AutoFilter
    ActiveSheet.Range("$A$20:$K$27").AutoFilter Field:=11, Criteria1:=">0", _
        Operator:=xlAnd
    Range("A21:A27").Copy
    Range("AJ28").PasteSpecial xlPasteValues
    Range("B21:B27").Copy
    Range("AL28").PasteSpecial xlPasteValues
    Range("K21:K27").Copy
    Range("AK28").PasteSpecial xlPasteValues
    Range("A20:J21").AutoFilter
   
End Sub

of kent er iemand nog een eenvoudigere notatie?
 
Code: 
Sub Create_Recorderlist()
 With Range("$A$20:$K$27")
       .AutoFilter 11, ">0"
         Range("A21:A27,K21:K27").Copy
         Range("AJ28").PasteSpecial xlPasteValues
         Range("B21:B27").Copy
         Range("AL28").PasteSpecial xlPasteValues
      .AutoFilter
 End With
End Sub

Of:
Code: 
Sub hsv()
Dim sn, hs_v
sn = Range("A20:K27").CurrentRegion
     hs_v = Application.Transpose(Split(Join(Filter([transpose(if(k21:k27>0,row(k2:k8),"~"))], "~", 0))))
     Range("AJ28").Resize(UBound(hs_v), 3) = Application.Index(sn, hs_v, Array(1, 11, 2))
End Sub
 
@HSV :thumb:

Code: 
Sub M_snb()
  sn = Application.Transpose(Filter([transpose((k21:k27>0)*row(1:7))], 0, 0))
  cells(28,36).Resize(UBound(sn), 3) = Application.Index([A21:K27], sn, Array(1, 11, 2))
End Sub
 
@snb,

Mooie verbetering. :cool:

Na de code te hebben geplaatst en ik de boel had afgesloten had ik al het vermoeden dat de split en de join er mogelijk wel uit konden.
Ik heb desondanks goed geslapen. :)
 
@snb:
bedankt voor het idee.
werkt super.
@HSV: eveneens bedankt voor de input.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan