Wie kann ich in Excel eine Zeile mit VBA ausblenden und verschieben?

Hallo,

wenn eine 1 in der Zeile L oder M oder N steht, soll die Zeile ausgeblendet und im Blatt "Monat" eingefügt werden.

Was mache ich hier falsch?

Sub Copy()
  Sheets("Offen").Select
  LetzteZeile = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row

  For i = 1 To LetzteZeile
    If Cells(i, 12) = 1 Then
      Rows(i & ":" & i).Select
      Selection.Copy
      Sheets("Monat").Select
      LetzteZeileZwei = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
      LetzteZeileZwei = LetzteZeileZwei + 1
      Rows(LetzteZeileZwei & ":" & LetzteZeileZwei).Select
      ActiveSheet.Paste
      Sheets("Offen").Select
      Section.EntireRow.Hidden = True
    End If
  Next i
End Sub

Bild zum Beitrag

2 Antworten

geri3d

Nutzer, der sehr aktiv auf gutefrage ist

im Thema programmieren

15.11.2021, 16:33

Mal sehen ob ich verstehe was du machen willst, ich sags gleich, ich bin kein Freund vom Copy/Paste in VBA.

Sub Copy()

Sheets("Offen").Select

LetzteZeile = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row

For i = 1 To LetzteZeile

  If Cells(i, 12) = 1 Then

    Rows(i & ":" & i).Select

    Selection.Copy

    Sheets("Monat").Select

    LetzteZeileZwei = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row

    LetzteZeileZwei = LetzteZeileZwei + 1

    Rows(LetzteZeileZwei & ":" & LetzteZeileZwei).Select

    ActiveSheet.Paste

    Sheets("Offen").Select

'Hier haperts

'Wo speicherst du die Row ab die du hiden willst
'Erstelle eine Variable die für die Row zuständig ist
'weil Excel nicht wissen kannst welche Zeile gemeint 'ist.

    Selection.EntireRow.Hidden = True

  End If

Next i

End Sub

Woher ich das weiß:Berufserfahrung

IchMalWiederXY

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

15.11.2021, 20:41

Sind Quell und Zielbereich gleich groß dann kann man einfach "zuordnen".

Worksheets("Ziel").Rows(1:1).Value = Worksheets("Quelle").Rows(2:2).Value

Nahezu jeden Ablauf kann man ohne Select, Activate, etc lösen was VIEL Zeit spart im Makro Ablauf und auch diverse Events nicht auslöst, die ggf für andere Zwecke gebraucht werden.
Ggf landet dieser Befehl auf der falschen Zeile
End(xlUp).Row..
Dieser arbeitet NUR DANN zuverlässig wenn man KEINE Filterung aktiv hat.
Es ist also ratsam zunächst die möglichen Autofilter per Makro auszuschalten.

MustafaFreiburg

Fragesteller

16.11.2021, 10:03

GUten Tag, sorry ich kann dir nicht folgen....ich möchte nur wenn in der Spalte L die "1" eingetragen wurde, dass die Zeile AUsgeblendet wird und im "Monat" eingetragen wird :-)

IchMalWiederXY

16.11.2021, 12:50

@MustafaFreiburg

Deine Überprüfung ob in der Spalte L eine 1 eingetragen wird findet im Worksheets Change event statt.
Click Mal im Projekt Explorer auf das Object welches dem Blatt entspricht.
Dann im Procedur DropDwon Worksheets_Change aus wählen.
nun in dieser Prozedur die Spalte prüfen. UND Target.Value = 1
==
Dein Copy Befehl ist nicht optimal.

Hallo an Alle,

kurz zur Erklärung: Ich füge Daten (immer 4 Zeilen) in eine "Datenbank" ein, allerdings, wenn nicht alles ausgefüllt wird, erscheint als Platzhalter "leer". Diese möchte ich gleich im Anschluss löschen, dass es keine weiteren Formeln durcheinander bringt bzw. weil er mir dann bei der nächsten Suche von einer leeren Zeile immer unterhalb der 4 Zeilen springt (wenn ich nicht mit "leer" fülle). :(

Ich habe jetzt schon mehreres probiert, aber entweder es löscht mir die Zeilen nicht oder es löscht auch Zeilen die eingefügt bleiben sollen... Bitte um fachmännische Hilfe. Bitte, DANKE!

Gerne umgehe ich auch "leer", wenn ich dann zumindest wirklich immer in der letzten freien Zeile bin...

Hier der momentan Code:

Range("N3:AE6").Select

Selection.Copy

Sheets("Datenbank").Select

Range("A520").Select

Cells(65000, 1).End(xlUp).Offset(1, 0).Select

Dim last As Integer

last = Cells(Rows.Count, 1).End(xlUp).Row + 1

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

If Cells(last).Value = "leer" Then

Rows(last).Delete Shift:=xlUp

End If

Sheets("BestandsKunde").Select

Range("H43").Select

End Sub

Lg, B

...zur Frage

Doppelte Werte suchen mit zusätzliche Bedingung dann eins löschen?

Hallo zusammen, ich hoffe dass jemand helfen kann weil ich weiß nicht weiter, danke.

Ich habe folgenden Code zum Suchen der Doppeltwerten in Spalte B und dann Löschung der Zeile:

Sub DoppelteZeilenLoeschen()

Dim letzteZeile As Long

Dim Zeile As Long

letzteZeile = Range("B" & Rows.Count).End(xlUp).Row

For Zeile = letzteZeile To 1 Step -1

If WorksheetFunction.CountIf(Range("B1:B" & Zeile), Range("B" & Zeile)) > 1 Then

Rows(Zeile).EntireRow.Delete

End If

End Sub

Jetzt meine Frage:

Was ich kann ich ergänzen, dass eine zweite Bedingung hier abgefragt wird vor der Löschung, also wenn Spalte "B" doppelwert hat dann Spalte "J" vergleichen, wenn Ergebnis der Spalte "J" gleich ist dann Zeile löschen, ansonsten weiter zählen.

Ein Bsp.

Spalte B Spalte J

ABCD 1234
ABCD 1234
ABCD 4567

Hier sollten nur Zeile2 gelöscht werden.

Vielen Dank im Voraus

...zur Frage

Excel - Button zur zum Einfügen einer neuen Zeile unterhalb eines Tabellenbereichs?

Hallo zusammen,

die letzten 4h habe ich - leider erfolglos - versucht, eine Lösung für mein Problem zu finden (Google hasst mich jetzt ;-) ): ich möchte am Ende einer Tabelle eine neue Zeile einfügen, inkl. der in den vorherigen Zeilen enthaltenen Formatierungen und Formeln.

Der präferierte Weg ist über einen Button, den ich in meinen Versuchen via ActiveX-CommandButton eingefügt hatte. Als Code war hinterlegt:

Private Sub CommandButton1_Click()
Dim LRow As Long
With ActiveSheet
  LRow = .Cells(Rows.Count, 1).End(xlUp).Row
  With .Rows(LRow - 1)
     .Copy
     .Insert xlShiftDown, _
        CopyOrigin:=xlFormatFromLeftOrAbove
  End With
End With
End Sub

Grds. hat das schon funktioniert, allerdings hat die Funktion leider immer die Zeile 1 repliziert, es soll aber unterhalb der Zeile 12 die neue (Eingabe)Zeile eingefügt werden.

Ich wäre begeistert, wenn mir einer von euch helfen kann.

Im Voraus lieben Dank,
Christian

...zur Frage

Excel VBA automatisch nächste freie Spalte nehmen?

hi hab mir mit Makros in VBA was zum übertragen von Daten in eine andere Arbeitsblatt zusammengebastelt. Dort soll es in eine Tabelle eingefügt werden die sich automatisch um eine Spalte nach rechts erweitern soll mit jedem Eintrag.

Sub inauftragplus()
   Range("D11:D22").Select
   Selection.Copy
   Sheets("Datenbank").Select
   ActiveWindow.SmallScroll Down:=-81
   Range("B9").Select
   ActiveSheet.Paste
   Sheets("Eingabe").Select
   Application.CutCopyMode = False
   Selection.ClearContents
End Sub

...zur Frage

VBA Makro Excel Letzte beschriebene Zeile vor Leerzeile, weitere Leerzeile einfügen

Guten Tag,

ich suche einen Code für ein Makro,dass in Spalte B unter der letzten beschriebenen Zelle vor einer leeren Zelle (also nicht am kompletten Ende des Sheets) eine Leerzeile einfügt. Habe schon etliche codes ausprobiert, zb

Sub letzte_Zeile()

'letzte benutzte Zelle in Spalte 2 finden DIM Ende As Long With ActiveSheet

Ende = .Cells(Rows.Count, 2).End(xlUp).Row End With

End Sub

Dieser sollte mir eig die letzte beschriebene Anzeigen,es funktioniert aber Garnichts.

Freue mich über Vorschläge. Viele Grüße

...zur Frage

Excel, Userform: Datum aus Textbox wird in der Zelle nicht als Datum erkannt?

Ich habe folgenden Code:

Private Sub Fertig_Click()

Dim last As Integer

last = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row + 1

Tabelle9.Cells(last, 1) = Format(Eingabe.Antragsdatum.Value, "dd.mm.yyyy")

End Sub

In der Zelle nachher wird es nicht als Datum erkannt.
Muss es aber als Datum sortieren können.

Ich habe schon viele Foreneinträge zu dem Thema gelesen, doch nichts davon funktioniert bei mir.

...zur Frage

Excel: Verbessertes Logging mit VBA Makro?

Hallo Zusammen

ich verwende im Moment ein kurzes Makro, um Änderungen in einem Tabellenblatt zu loggen.

Es registriert aber nur einzelne Änderungen, nicht multi-selektion oder Löschen von Spalten. Kann ich das mit separaten Privaten Subs übernehmen?

Und kann ich aufnehmen, was die Target- und "PreVal"-Adresse war (Offset 4+5)

Code:

Dim PreVal
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
PreVal = Target.Value
 
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  
    On Error GoTo 0
    
    If Target.Value <> PreVal Then
        With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
            .Offset(1, 0) = Now
            .Offset(1, 1) = PreVal
            .Offset(1, 2) = Target.Value
            .Offset(1, 3) = Environ("Username")
        End With
    End If
 
End Sub

...zur Frage

Wie kann ich meine Excel (VBA) "Zeile Ein- und Ausblenden Formel" vereinfachen?

Hallo zusammen

Ich suche nach einer schnelleren Formellösung, welche alle Zeilen ausblendet, wenn in Spalte A der jeweiligen Zeile das Formelergebnis 0 steht und wieder einblendet, wenn das Ergebnis 1 ist. Die Rechnung passiert dabei auf einer anderen Tabelle; in der Tabelle mit dem Makro steht dann lediglich: ='Tabelle2'!A11 (Dieser Wert wird somit übertragen und ändert sich demzufolge)

Makro:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Range("A11") = 0 Then

Rows("11:12").EntireRow.Hidden = True

End If

If Range("A11") <> 0 Then

Rows("11:12").EntireRow.Hidden = False

End If

If Range("A13") = 0 Then

Rows("13:14").EntireRow.Hidden = True

End If

If Range("A13") <> 0 Then

Rows("13:14").EntireRow.Hidden = False

End If

If Range("A15") = 0 Then

Rows("15:16").EntireRow.Hidden = True

End If

If Range("A15") <> 0 Then

Rows("15:16").EntireRow.Hidden = False

End If

...

(UNTERBRUCH) ...........das geht weiter bis "A360"

...

End Sub

Dieser Ablauf dauert jedoch eine gefühlte Ewigkeit; geht das schneller?

Danke euch.

Gruss Swen

...zur Frage

VBA CODE Zellen nach bestimmten Textinhalt suchen und Zeile Färben?

Hallo, kann mir bitte jemanden mit dem Code behilflich sein?

Dieser Code sucht die Zellen in Spalte"A" nach bestimmten Textinhalt ab und bei Treffer löscht er die zughörige gesamte Zeile. Meine Frage: kann man diesen Code so ändern, dass anstatt die gefundene Zeile zu löschen nur mit einer Farbe z.B. Orange (44) färbt? Vielen Dank im Voraus.

Sub zeilenloeschen()
  Dim i As Long
  Dim letzteZeile As Long
  Dim suchBereich As Range
  Dim gefunden As Range
  Dim ersterTreffer As String
  Dim suchWert As String
  suchWert = "1" 'hier kommt dein Suchwert rein
  
  With ThisWorkbook.Sheets("Sheet4")
    letzteZeile = .Range("A" & Rows.Count).End(xlUp).Row
    Set suchBereich = .Range("A1:A" & letzteZeile)
    Set gefunden = suchBereich.Find(What:=suchWert, LookAt:=xlPart)
    If Not gefunden Is Nothing Then
      ersterTreffer = gefunden.Address
      Do
        gefunden.Activate
        ActiveCell.EntireRow.Delete shift:=xlUp
        Set gefunden = suchBereich.Find(What:=suchWert, LookAt:=xlPart)
      Loop While Not gefunden Is Nothing
    End If
  End With
End Sub

...zur Frage

Excel VBA - Darstellung waagerecht-vertikal beim kopieren ändern?

Hallo,

ich habe in einer fertigen Tabelle etwas geändert, um die Eingabe der Daten zu erleichtern. Statt die Daten in der Spalte zu erfassen, werden die Daten jetzt in einer Zeile eingegeben.

Also statt vorher in B10, B11, B12... jetzt in B10, C10, D10...

Die Daten werden mit Hilfe eine Makros in eine andere Tabelle transferiert und waagerecht eingefügt.

Da ich aber die Eingabeart verändert habe, werden die Daten jetzt untereinander in die Tabelle eingefügt.

Ich weiß, dass das mit "Application.Transpose" zu tun hat.

Nun weiss ich aber nicht wie ich die Zeile umbenennen muss, damit die waagerechte Darstellung übernommen wird.

Wie ändere ich die Zeile, damit die angesprochenen Werte waagerecht in die Zeile kopiert werden?

Hier der komplette Code:

Sub transfer_werte()
    Dim rngKunde    As Excel.Range
    Dim rngReklam   As Excel.Range
    Dim rngArtikel   As Excel.Range

     Set rngKunde = Worksheets("Eingaben").Range("C5:C10")
    Set rngReklam = Worksheets("Eingaben").Range("D5:D9")
    Set rngArtikel = Worksheets("Eingaben").Range("C14:L14")
   
        With Worksheets("Liste")
          With .Cells(.Rows.Count, 2).End(xlUp)
               .Offset(1, 0).Resize(rngKunde.Columns.Count, rngKunde.Rows.Count).Value = Application.Transpose(rngKunde.Value)
        End With
    End With
   
    With Worksheets("Liste")
        With .Cells(.Rows.Count, 8).End(xlUp)
             .Offset(1, 0).Resize(rngReklam.Columns.Count, rngReklam.Rows.Count).Value = Application.Transpose(rngReklam.Value)
        End With
    End With
  
   With Worksheets("Liste")
        With .Cells(.Rows.Count, 14).End(xlUp)
             .Offset(1, 0).Resize(rngArtikel.Columns.Count, rngArtikel.Rows.Count).Value = Application.Transpose(rngArtikel.Value)
        End With
    End With
      
End Sub

...zur Frage

Target.Address Fehlermeldung Laufzeitfehler "424": Objekt erforderlich?

Hallo,

ich verschiedene Befehle mit VBA realisieren, um eine Auswahlliste anzupassen. Zum einen sollen Zellen ausgeblendet werden, wenn eine bestimmte Zelle leer ist und daher ein ganzer Teil der Liste entfallen kann. Der Befehl sieht folgendermaßen aus:

Sub HdlZellenVerbergen()

If Target.Address = "$C$9" Then

If C9 = "" Then

Rows("164:195").Hidden = True

Else

Rows("164:195").Hidden = False

End If

End Sub

Da ich mich nun Hals über Kopf in VBA geschmissen habe und schon einige Male Internetrecherche betrieben habe, weiß ich nicht wo der Fehler liegt, da mir hier die Erfahrung fehlt. Der Fehler lautet wie in der Überschrift angegeben. Was muss ich machen, damit das ganze nun funktioniert.

Ein ähnliches Problem erwarte ich dann bei folgendem Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$C$8" Then

If [C8] = "x" Then [D22] = "y"

End If

End Sub

Auch hier wäre eine Hilfe super.

Vielen Dank im Voraus.

...zur Frage

Excel VBA Makro Code?

Guten Tag zusammen,

Undzwar geht es darum das ich ein Makro erstellt habe der sieht so aus :

Sub Makro1()

' Makro1 Makro

Range("D3").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("1M").Select

Range("C6").Select

ActiveSheet.Paste

Sheets("Tabelle1").Select

Range("J3").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("1M").Select

Range("C7").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("Tabelle1").Select

Range("R3").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("1M").Select

Range("C13").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("D26").Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Tabelle1").Select

Range("H3").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

End Sub

Das Problem ist jetzt das ich möchte das er in der Excel Tabelle jede Zeile mit diesem Makro ausfüllt sprich er soll bei Zeile 3 anfangen und bis 322 weiterführen ich habe 2 Mappen 1. "Tabelle1" und "1M"

Tabelle1 hatt die 322 Zeilen aber er springt nicht zur jeder Zeile und die Zelle "D3" , "J3", "R3", "H3" sollten dann auf die nächste Zeile Springen Sprich "D4", "J4" , "R3" , "H4" wenn er auch in der 4 Zeile ist

die restlichen Zellen sollen festbleiben zugehörig zu Mappe "1M"

ich hoffe es ist verständlich was ich meinte :'D

...zur Frage

VBA Code Erklärung

Guten Abend zusammen. Könnte mir jemand weiterhelfen bei diesem Code. Was macht er genau in Excel? Also Die einzelnen Schritte die er durchläuft,.

Option Explicit

Public Sub Double_Red()
Dim lngZeile As Long
Dim lngZeilenSprung As Long
Dim strSuchwert As String

lngZeile = Cells(Rows.Count, 4).End(xlUp).Row

  For lngZeilenSprung = lngZeile To 1 Step -1
    strSuchwert = Cells(lngZeilenSprung, 4).Value
      If Application.WorksheetFunction.CountIf(Range(Cells(1, 4), Cells(lngZeile, 4)), strSuchwert) <> 1 Then
        Cells(lngZeilenSprung, 4).Interior.ColorIndex = 3
      End If
  Next lngZeilenSprung

End Sub

...zur Frage

Excel VBA - Spalte von Unten nach Oben durchgehen?

Servus Leute, ich hätte eine kleine Frage zu VBA:

Wie schaffe ich es, dass mein Programm eine bestimmte Zeile von unten nach oben durchläuft.

Hier meine Variante für das durchlaufen von Oben nach Unten

maxRow2 = sheet2.Cells(sheet2.Rows.Count, "A").End(xlUp).row

For row2 = 1 To maxRow2
Do something     
Next row2

Wie muss ich das abändern, damit die Spalte von Unten nach Oben durchgelaufen wird?

...zur Frage

Was möchtest Du wissen?

Deine Frage stellen