Waarden kopieren met macro

[Eggie]

Hallo,

Ik heb een bestand waarin ik d.m.v. een macro bepaalde records naar een andere sheet wil kopieren.
Deze records dienen gewoon handmatig geselecteerd te worden.
Nu wil ik graag dat deze records alleen gekopieerd kunnen worden met die macro wanneer kolom a en b niet leeg zijn.
Als dit wel het geval is zou ik graag een msgbox willen waarin staat dat deze nog ingevuld dienen te worden.

Weet iemand hoe ik zo'n macro moet schrijven?

Alvast bedankt,

Eggie

 

[wlsandman]

Zoiets

Sub opslaan()
If ActiveSheet.Columns("A:B").Text = "" Then
MsgBox "Er zijn geen gegevens ingevoerd"
Else
ActiveWorkbook.Save
End If
End Sub

 

[Eggie]

Hallo wlsandman,

Ik ben een heel eind nu, alleen moet ik nu in plaats van ActiveSheet.Columns("A:B") ervoor zorgen dat de cel wordt gecontroleerd in de rij die op dat moment geselecteerd is (dus niet de hele kolom).
Dus stel dat rij 10 gekopieerd moet worden moet gecontroleerd worden of range A10/B10 leeg is, maar als rij 11 geselecteerd is range A11/B11 etc.
Voor de andere rijen geld dan niet dat Kolom A en B ingevuld moeten zijn.
Weet jij hoe dit opgelost moet worden?

Alvast bedankt,

Egbert

 

[wlsandman]

Sub Controle()
If ActiveCell.Text = "" Then
MsgBox "Er zijn geen gegevens ingevoerd!"
Else
MsgBox "Er zijn wel gegevens ingevoerd!"
End If
End Sub

Zoiets dan

 

[Wigi]

Vormen de te kopiëren records steeds een aaneengesloten bereik? Of zitten er records tussen die men niet selecteert?

 

[Eggie]

Hey,

bedankt voor je snelle reactie!!
Durf het bijna niet mee te vragen, maar het het moet als volgt gaan werken:

Stel dat regel 300 gekopieerd moet worden naar een andere sheet, moet de gebruiker de gehele regel selecteren (door op het rijnummer te klikken).
Daarna dient een button aangeklikt te worden waaraan de macro gekoppeld is die dan eerst controleerd of kolom A en B (fictief) gevuld zijn (alleen van regel 300 dus).
Als dat zo is, dan moet regel 300 gecopeerd worden, anders een msgbox.
Dat copieer gedeelte lukt wel, het probleem is hoe laat ik de macro controleren of kolom a en b van alleen de geselecteerde rij gevuld zijn.

In ieder geval bedankt voor zover, hoop dat je hier een oplossing voor hebt, zou mij erg helpen!!

Groeten Eggie

 

[Wigi]

Zoiets?

Sub kopieren()
Dim c As Range, msg As String

On Error Resume Next
    For Each c In Intersect(Columns("A:B"), Selection.EntireRow)
        If IsEmpty(c) Then msg = msg & vbCr & c.AddressLocal(0, 0)
    Next c
On Error GoTo 0
If msg <> "" Then MsgBox "Lege cellen: " & msg
End Sub

Wigi

 

[Eggie]

Hallo Wigi,

de te kopieeren record zijn inderdaad aaneengesloten:


A B C D
1
2 x x x
3 x x x x
4

Stel dat regel 2 en 3 nu gekopieerd moeten worden, moet er bij 2 een melding komen.
Ook 3 hoeft nu niet gekopieerd te worden aangezien eerst A2 gevuld moet worden en daarna opnieuw gekopieerd kan worden...

Bedankt voor je hulp!

Eggie

 

[wlsandman]

Zoiets?

Sub kopieren()
Dim c As Range, msg As String

On Error Resume Next
    For Each c In Intersect(Columns("A:B"), Selection.EntireRow)
        If IsEmpty(c) Then msg = msg & vbCr & c.AddressLocal(0, 0)
    Next c
On Error GoTo 0
If msg <> "" Then MsgBox "Lege cellen: " & msg
End Sub

Wigi

Wat is de functie van Intersect in bovenstaande formule?

 

[Eggie]

Wigi,

Dit is perfect, alleen nu gaat het in werkelijkheid om kolom S en V.
Hoe pas ik dit aan, dacht dat ik dat wel zou weten... Als ik van
Intersect(Columns("A:B"),

Intersect(Columns("S,V") maak werkt het niet...

Alvast bedankt, dit moet gaan lukken. Hoop dat je mijn laatste vraag ook nog kan beantwoorden...

Groeten Eggie

 

[wlsandman]

Intersect(Columns("S:V")

is het

 

[Eggie]

maar dan controleerd de code toch ook kolom T en U, en die mogen wel leeg zijn...

 

[Wigi]

Werkt dit?

Sub kopieren()
Dim rngLegeCellen As Range

On Error Resume Next
Set rngLegeCellen = Intersect(Range("S:S, V:V"), Selection).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If rngLegeCellen Is Nothing Then
    Selection.Copy Sheets("Sheet2").Range("A1")
Else
    MsgBox "Vul eerst cel " & rngLegeCellen(1).AddressLocal(0, 0)
End If
End Sub

Wigi

 

[Eggie]

Opgelost!!

Hallo Wigi,

helemaal super, dit is precies wat ik bedoelde!!
Echt heel erg bedankt voor de moeite.

Mvg,

Egbert

 

[Wigi]

Hallo Wigi,

helemaal super, dit is precies wat ik bedoelde!!
Echt heel erg bedankt voor de moeite.

Mvg,

Egbert

You're welcome Eggie.