Zoek functie mbv macro

[susanthuis]

Hallo, ik heb een macro nodig die de cellen in kolom A beginnend met 10 selecteert (zie bijlage), daarna 20 EN 40, daarna 30 , daarna 60, daarna 80. Hoe doe ik dat?

 

[HSV]

Een geintje.

Sub hsv()
Dim i As Long
For i = 10 To 100 Step 10
  Range(Range("A1"), Cells(i, 1)).Select
   Application.Wait DateAdd("s", 5, Now)
 Next
End Sub

 

[susanthuis]

Een geintje.

Sub hsv()
Dim i As Long
For i = 10 To 100 Step 10
  Range(Range("A1"), Cells(i, 1)).Select
   Application.Wait DateAdd("s", 5, Now)
 Next
End Sub

Harry, dankjewel voor het script!! Toch wil ik iets meer. Wat moet er aan het script aangepast worden wanneer ik alleen 20 EN 40 wil hebben, vanaf kolom A tm D? Gr, Susan

 

[HSV]

Wat wil je ermee Susan.

Waarom selecteren?
Selecteren is meestal overbodig.

 

[susanthuis]

Wat wil je ermee Susan.

Waarom selecteren?
Selecteren is meestal overbodig.

Harry, ik ontvang wekelijks 1 overzicht met deze nummers die ik vervolgens per serie (10, (20 en 40), 30, etc) uitsplits. Ik selecteer/kopieer en plak ze in een apart bestand. Dat werk zou ik graag willen automatiseren. Gr, Susan

 

[HSV]

Hallo Susan,

Gaan die allemaal naar een bestand met dezelfde naam.
Hoe moet ik me "eerst 10 dan 20 en 40 , 30 enz. voorstellen.

 

[susanthuis]

Hallo Susan,

Gaan die allemaal naar een bestand met dezelfde naam.
Hoe moet ik me "eerst 10 dan 20 en 40 , 30 enz. voorstellen.

Nee, die gaan separaat in een bestand dat weer een andere naam heeft. De nummers die met 10 beginnen, komen terecht in het bestand met bestandsnaam ' A', de nummers die met 20 en 40 beginnen komen in het bestand met bestandsnaam 'B', de nummers die met 30 beginnen komen in het bestand met bestandsnaam ' C' etc. Dit gaat door tm nummers die beginnen met 80. Gr, Susan

 

[HSV]

Zijn er nog meer nummers die je zoekt, of is het dan de volgorde aanhouden.
10 → a
20 en 40 → b
30 → c
50 als die ook voorkomt? → d
60 → e
70 → f
80 → g

 

[susanthuis]

Zijn er nog meer nummers die je zoekt, of is het dan de volgorde aanhouden.
10 → a
20 en 40 → b
30 → c
40 → d
50 als die ook voorkomt? → e
60 → f
70 → g
80 → h

50 komt niet voor, dit is het wel! Gr, Susan

 

[HSV]

Nog één vraag voor ik alles weer de prullebak in moet gooien.
Bestaan de getallen altijd uit 5 cijfers ?

 

[susanthuis]

Nog één vraag voor ik alles weer de prullebak in moet gooien.
Bestaan de getallen altijd uit 5 cijfers ?

De getallen bestaan alleen uit 5 cijfers. Gr, Susan

 

[HSV]

Maak een map aan met de naam "Susan"; in de code op de "D" schijf (anders aanpassen in de code).
In de map "Susan" maak je 6 bestanden met de namen resp. "a,b,c,d,e,f".
Dus elke map z'n eigen naam (anders aanpassen in de code).
Probeer onderstaande code.

Sub hsv()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheets(1).UsedRange.Columns(1)
   .AutoFilter 1, ">9999", xlAnd, "<11000"
       Workbooks.Open "D:\Susan\a.xlsx"
ThisWorkbook.Sheets(1).AutoFilter.Range.Offset(1).SpecialCells(12).Copy ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
       ActiveWorkbook.Close True
    .AutoFilter
    .AutoFilter 1, ">19999", xlAnd, "<30000"
       Workbooks.Open "D:\Susan\b.xlsx"
ThisWorkbook.Sheets(1).AutoFilter.Range.Offset(1).SpecialCells(12).Copy ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .AutoFilter
    .AutoFilter 1, ">39999", xlAnd, "<50000"
  ThisWorkbook.Sheets(1).AutoFilter.Range.Offset(1).SpecialCells(12).Copy ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
   ActiveWorkbook.Close True
    .AutoFilter
    .AutoFilter 1, ">29999", xlAnd, "<40000"
       Workbooks.Open "D:\Susan\c.xlsx"
ThisWorkbook.Sheets(1).AutoFilter.Range.Offset(1).SpecialCells(12).Copy ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
       ActiveWorkbook.Close True
    .AutoFilter
    .AutoFilter 1, ">59999", xlAnd, "<70000"
       Workbooks.Open "D:\Susan\d.xlsx"
ThisWorkbook.Sheets(1).AutoFilter.Range.Offset(1).SpecialCells(12).Copy ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
       ActiveWorkbook.Close True
    .AutoFilter
    .AutoFilter 1, ">69999", xlAnd, "<80000"
       Workbooks.Open "D:\Susan\e.xlsx"
ThisWorkbook.Sheets(1).AutoFilter.Range.Offset(1).SpecialCells(12).Copy ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
       ActiveWorkbook.Close True
    .AutoFilter
    .AutoFilter 1, ">79999" ', xlAnd, "<90000"
       Workbooks.Open "D:\Susan\f.xlsx"
ThisWorkbook.Sheets(1).AutoFilter.Range.Offset(1).SpecialCells(12).Copy ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
       ActiveWorkbook.Close True
    .AutoFilter
  End With
  MsgBox "Bekijk alle bestanden", , "Alle bestanden zijn bijgewerkt "
Application.DisplayAlerts = True
End Sub