Klantenlijstje

[jarre2]

Hallo Excelgebruikers,

Op 1 augustus heb ik via dit forum een goed werkende macro verkregen. De vraag betrof over “rijen selectie”.

Wat doet deze macro?
Van alle rijen in het werkblad "klanten" die door middel van een "s" in kolom A zijn geselecteerd kopiëren naar werkblad "afspraken"

De vraag:
Is er een mogelijkheid om in het begin van de macro te testen of er in kolom A (van werkblad klanten) wel een “s” is geplaatst. Indien er geen enkele "s" is geplaatst, dit kenbaar maken via een schermmelding.
Het bereik van de kolom is A2:A300

Bij voorbaat dank
Jarre

 

[JeanPaul28]

Test deze eens
De rode tekst heb ik bijgevoegd

Sub Maybe()
Dim lr As Long
Dim Ants As Integer
Ants = WorksheetFunction.CountIf(Sheets("Klanten").Range("A:A"), "s")
If Ants < 1 Then
MsgBox "Er zijn geen selecties gevonden, deze macro wordt nu beeindigd"
Exit Sub
End If
lr = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
Sheets("Afspraken").Range("A2", Sheets("Afspraken").Range("A" & Rows.Count).End(xlDown).Resize(, 17)).ClearContents
With ActiveSheet
.AutoFilterMode = False
.Range("A1:A" & lr).AutoFilter field:=1, Criteria1:="s"
.Range("B2:R" & lr).SpecialCells(12).Copy Sheets("Afspraken").Range("A2")
.AutoFilterMode = False
End With
Sheets("Afspraken").Activate
With ActiveSheet
.Cells.EntireColumn.AutoFit
.Range("A1").CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("C2"), Order2:=xlAscending, Header:=xlYes
With .PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
.PrintOut Copies:=1, Preview:=False
End With
Application.ScreenUpdating = True
End Sub

 

[jarre2]

Hallo Jean-Paul,

Je code werkt perfect! Precies wat de bedoeling was. Hartelijk dank voor je snelle reactie. Ik heb er ook nog wat van geleerd.
Mvg,
Jarre