Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema RefEdit
BildScreenshot zu RefEdit RefEdit-Seite mit Beispielarbeitsmappe aufrufen

Abfrage Bereich leer


Betrifft: Abfrage Bereich leer von: Moritz
Geschrieben am: 23.10.2017 13:47:52

Hallo Excel-Forum,
um ein Tabellenblatt zu kopieren, soll überprüft werden, ob in einem bestimmten Bereich etwas steht oder nicht, damit eine Spalte entweder kopiert oder nicht kopiert wird.(siehe Besispieldatei https://www.herber.de/bbs/user/117167.xlsm).
Mein Ansatz funktioniert irgendwie nicht richtig. Weiß jemand von euch, was ich verändern muss?
Über eine Antwort freue ich mich sehr!
Grüße
Moritz

  

Betrifft: AW: Abfrage Bereich leer von: ChrisL
Geschrieben am: 23.10.2017 15:45:48

Hi Moritz

z.B....

Private Sub CommandButton1_Click()
Dim intEnde As Long, rngBereich As Range
    
With Worksheets("Tabelle1")
    intEnde = .Cells(Rows.Count, 1).End(xlUp).Row
    If intEnde = 1 Then Exit Sub
    Set rngBereich = .Range("C2:C" & intEnde)
End With

If rngBereich.Cells.Count = WorksheetFunction.CountBlank(rngBereich) Then
    rngBereich.Offset(0, -1).Copy
Else
    rngBereich.Copy
End If
End Sub
cu
Chris


  

Betrifft: AW: Abfrage Bereich leer von: Moritz
Geschrieben am: 23.10.2017 16:13:07

Hi Chris,
vielen Dank für deine Antwort. Sehe gerade, dass ich aus Versehen den Link falsch angegeben habe. Hier der richtige Verweis: https://www.herber.de/bbs/user/117167.xlsm.

Ich meinte eigentlich, dass, wenn in Spalte C ab Zelle C2 etwas steht, der ganze Bereich (1,1) bis (Ende,3) kopiert wird. Ansonsten soll der Bereich (1,1) bis (Ende,2) kopiert werden.
Wenn du noch einen Tipp hättest, wie ich das umsetzen kann, wäre das super!
Grüße
Moritz


  

Betrifft: AW: Abfrage Bereich leer von: ChrisL
Geschrieben am: 23.10.2017 16:22:26

Hi Moritz

Private Sub CommandButton1_Click()
Dim intEnde As Long, rngBereich As Range
    
With Worksheets("Tabelle1")
    intEnde = .Cells(Rows.Count, 1).End(xlUp).Row
    If intEnde = 1 Then Exit Sub
    Set rngBereich = .Range("C2:C" & intEnde)
End With

If rngBereich.Cells.Count = WorksheetFunction.CountBlank(rngBereich) Then
    rngBereich.Resize(rngBereich.Rows.Count, 2).Offset(0, -2).Copy
Else
    rngBereich.Resize(rngBereich.Rows.Count, 3).Offset(0, -2).Copy
End If
End Sub
cu
Chris


  

Betrifft: AW: Abfrage Bereich leer von: Moritz
Geschrieben am: 23.10.2017 16:42:06

Genau das habe ich gesucht. Vielen Dank!!!!!


Beiträge aus den Excel-Beispielen zum Thema "Abfrage Bereich leer"