Excel Makro VBA | Zellenbereich erweitern und nach rechts verschieben?

Guten Tag,

ich würde eine Tabelle erstellen wollen, welche man immer links erneuern kann, sprich mit dem Tastenklick auf die Schaltfläche, soll eine neue Spalte (nur von G6:G20) eingefügt werden. Gleichzeitig (bzw. davor) sollen die alten Spalten nach rechts geschoben werden.

Ich habe es versucht, durch ein Bild zu verdeutlichen.

Habe im Internet folgenden Ansatz gefunden. Habe in VBA aber nur schlechte Kenntnisse, weshalb ich den Code nicht auf mein Problem anpassen kann. Könnt ihr mir da helfen?

2. Das Eingefügte (also die Vorlage(Tabellenstriche)) kann ja von irgendwo eingefügt werden: zB: X1000:X1014 - richtig?

Bild zum Beitrag

28.01.2021, 11:39

Sub aufdroeseln()
   Dim Zelle As Range
   Columns("C7:C14").Insert Shift:=xlToRight
   For Each Zelle In Range("C7:C14" & Range("C65536").End(xlUp).Row)
      If Zelle.Font.Bold = True Then
         Zelle.Offset(0, 1).Value = Zelle
         Zelle.ClearContents
      End If
   Next
   Columns("C7:C14").Font.Bold = False
End Sub

2 Antworten

Suboptimierer

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

28.01.2021, 10:44

Wenn ich G6:G20 markiere und dann Start → Zellen → Einfügen → Zellen einfügen... → Zellen nach rechts verschieben → OK ausführe, dann wird eine Spalte für die markierten Zeilen in der markierten Spalte eingefügt.

Geht es dir um die Formatierung, die dann nicht stimmt?

Woher ich das weiß:Berufserfahrung – Programmierer

IchMalWiederXY

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel, VBA

28.01.2021, 10:02

Warum denn eine "Spalte" einfügen.
Einfach die Inhalte von G6:G20 nach Rechts verschieben/kopieren.
Was bereits dort steht wird überschrieben und die Zellen G6:G20 werden geleert.

""Verschieben" der Zellen eins nach Rechts
Const SpaltenAnfang = 7
Const SpaltenEnde = 100 'Wenn es irgendwann über die 100 Spalten hinaus geht, dann diese Zahl erhöhen.

Worksheets("blabla").Range(Worksheets("blabla").Cells(6,SpaltenAnfang+1),Worksheets("blabla").Cells(2,SpaltenEnde+1)) = _
Worksheets("blabla").Range(Worksheets("blabla").Cells(6,SpaltenAnfang),Worksheets("blabla").Cells(6,SpaltenEnde))

Löschen der Inhalte Spalte G6->20
Worksheets("blabla").Range("G6:G20").DeleteContents
======
Generell glaube ich aber du solltest deine Daten anders strukturieren, um am Schluss wirklich übersichtlich zu sein. (Beschäftige dich mit PIVOT)

xXThreeGamerXx

Beitragsersteller

28.01.2021, 17:04

Was muss ich hier denn noch alles anpassen?

Ähnliche Beiträge

Wie setze ich das richtig in VBA um?

Hallo,

ich habe folgenden Code in Excel VBA. Leider komme ich nicht weiter.

Ich suche einen Wert der Zelle E1 in Spalte A1.

Ist der Wert aus E1 vorhanden, soll ein Sub geöffnet werden.

Ist dieser Wert nicht vorhanden, soll eine MsgBox geöffnet werden und nach dem Schließen der Box die UserForm1.

Aktuell macht der Code folgendes: Egal ob der Wert vorhanden ist oder nicht, es wird die MsgBox geöffnet und der Code wird auch bei richtiger Zahl nicht ausgeführt.

Ich würde mich freuen, wenn mir einer helfen kann bei meiner Spielerei. Danke.

Sub suche()
Dim zelle As Range


For Each zelle In Sheets("Tabelle1").Range("A1:A1000").Cells
    If zelle.Value = Sheets("Tabelle1").Range("E1") Then
    'Sheets("Tabelle1").Activate
    zelle.Activate
    Call create
    Exit For
    Else

    MsgBox "Nr. ist nicht vorhanden!", vbExclamation
    UserForm1.Show
    Exit Sub
    End If
    'Call create
    Next
End Sub

...zum Beitrag

Wie kann man in Excel per VBA abhängig von einem Wert Spalten aus-/einblenden?

Hey. Ich weiß zu diesem Thema gibt es schon ein paar Einträge im Netz. jedoch habe ich es nie für mich umformuliert bekommen. Vielleicht kann mir hier jemand helfen?

In Zelle G6 steht ein Wert von 1-6. Abhängig davon sollen dann immer andere Spalten ausgeblendet werden. Mein Code zur Zeit:

Sub Ausblenden()
'
' Ausblenden Makro
'
' Tastenkombination: Strg+a
'
    If "G6" = "1" Then
                Columns("v:bn").EntireColumn.Hidden = False
                Columns("v:bn").EntireColumn.Hidden = True
            Else
                If "G6" = "2" Then
                    Columns("v:bn").EntireColumn.Hidden = False
                    Columns("ae:bn").EntireColumn.Hidden = True
                Else
                    If "G6" = "3" Then
                        Columns("v:bn").EntireColumn.Hidden = False
                        Columns("an:bn").EntireColumn.Hidden = True
                    Else
                        If "G6" = "4" Then
                            Columns("v:bn").EntireColumn.Hidden = False
                            Columns("aw:bn").EntireColumn.Hidden = True
                        Else
                            If "G6" = "5" Then
                                Columns("v:bn").EntireColumn.Hidden = False
                                Columns("bf:bn").EntireColumn.Hidden = True
                            Else
                                If "G6" = "6" Then
                                    Columns("v:bn").EntireColumn.Hidden = False
                                End If
                            End If
                        End If
                    End If
                End If
    End If
End Sub

Ich bin ein VBA anfänger, also bitte seit nachsichtig x). Danke schon einmal im voraus!

...zum Beitrag

Richtig Einfügen in Excel-VBA?

Ich bin mir auch nicht sicher ob ich Richtig in VBA einfüge, der Sub Kopieren funktioniert nicht.

Mein Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("E8")) Is Nothing Then

Cells.EntireRow.Hidden = False

If Range("E8").Value = "Rogo AC" Then

Columns("U:AH").Hidden = True

Columns("U").Hidden = False

ElseIf Range("E8").Value = "Shunt 100A" Then

Columns("U:AH").Hidden = True

Columns("V").Hidden = False

End If

End Sub

-------------------------------------------------------------------------------------------------------------------------------

Sub Kopieren_speichern()

For i = 27 To 37

If Range("AK" & i).Value > 1 Then

Range("M" & i).Value = Range("AK" & i).Value

End If

Next i

End Sub

Danke im Voraus

...zum Beitrag

EXCEL VBA: Zeitstempel automatisch setzen sobald Zelle nicht leer?

Hallo,

ich suche nun schon länger eine Lösung für mein Problem und komme im Moment nicht so recht weiter weil mir VBA irgendwo anscheinend meine Formel abbricht - keine ahnung, bin ja auch blutiger Anfänger.

Versuche nun schon seit Stunden es hinzubekommen, dass in jeder Zeile von Spalte A ein Zeitstempel gesetzt wird, wenn in Spalte B ein Wert (egal ob text oder Zeit) gesetzt ist.

Den Zeitstempel schaff ich schon zu setzen - aber noch nicht mit der Bedingung dass er automatisch gesetzt werden soll wenn jemand in Spalte B was eintippt. Möchte also auch vermeiden, dass jemand mit einen Buttonklick oder dem Aufrufen des Makros dieses erst starten muss um den Zeitstempel zu setzen. <br>

Mein Code bisher:

Sub ZeitstempelMakro()

If Not IsEmpty("B:B) then

Columns("A:A").Select

Selection.Find(What:="").Activate

ActiveCell.FormulaR1C1 = Format(Now, "dd.mm.yyyy hh:mm:ss")

End If

End Sub

Vielleicht kann mir jemand helfen und mir den kleinen Logikfehler finden helfen

danke!

...zum Beitrag

VBA Excel - Spalten kopieren und Einfügen?

Ich möchte mittels VBA-Button gerne eine Anzahl von Spalten kopieren um meine Kalkulation somit zu erweitern.

Spalte E:H bilden die "Master-Spalten-Set". Diese Spalten sollen immer vor der Spalte in der die Zelle "Total Qty" vorkommt kopiert werden.

Mein aktueller Code lautet:

Sub Makro1()
    Columns("E:H").Select
    Selection.Copy
    Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight
End Sub

Wie muss ich diese Code erweitern um variable vor der Spalte mit der Zelle "Total Qty" das "Master-Spalten-Set" einzufügen?

Danke

...zum Beitrag

Excel VBA Einträge als Liste untereinander kopieren?

Hay zusammen,

meine Frage ist wie kann ich die Werte Links in der Tabelle rechts untereinander einfügen? Es muss eine Abfrage erfolgen ob die Zeile leer ist und wenn nicht, dann darunter einfügen.

Habe da ein Makro gefunden aber vielleicht kann mir jemand sagen wie der funktioniert. Kenne mich damit nicht aus. Habe die Werte geändert (Zellenangaben) und trotzdem fügt er die Daten untereinander ein.

Sub Makro2()
'
' Makro2 Makro
'
' Tastenkombination: Strg+e
'
Dim Zelle As Range
Dim Bereich As Range
Set Bereich = Range("J3:N3")
For Each Zelle In Bereich
    If IsEmpty(Zelle) Then Exit For
Next Zelle
With ActiveSheet
    .Range("A3:E3").Copy
    Zelle.PasteSpecial Paste:=xlPasteAll, Transpose:=True
    .Range("A3:E3").ClearContents
End With
Application.CutCopyMode = False
End Sub

Verstehe das System nicht ganz.

Kurz: Durch Klick auf Buchen sollen die Werte rechts eingefügt werde. Untereinander bei jeder weiteren Buchung.

...zum Beitrag

Excel Vba Typen Unverträglich?

Sub test()

For i = 1 To 10

Worksheets("Tabelle1").Range("C1:C10") = IIf((IsEmpty(Range("A1:A10")) + IsEmpty(Range("B1:B10"))) <> 0, "Not Calculable", (Range("A1:A10") - Range("B1:B10") + 1))

End Sub

...zum Beitrag

Excel VBA Selection begrenzen?

Hallo zusammen.

Ich komme leider beim meinem Problem nicht alleine weiter.

In meiner Tabelle werden in Spalte 2 und Zeile 4 Zeichen angezeigt, sobald ein Bereich selektiert wird. Die Zeichen sollen sich allerdings nur auf die Range J7:OJ57 beschränken, auch wenn die Selektion über die Range hinausgeht.

Denn jetzt, wenn ich z.B. eine Spalte markiere, schreibt der Code mir alle Zeichen in jede Zeile der Spalte, was fatal ist.

Kann ein Profi kurz helfen? :)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("J6:OJ57")) Is Nothing Then
Dim cell As Range
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Application.EnableEvents = False
   Range("B6:B57").ClearContents
   Range("J4:OJ4").ClearContents
For Each cell In selection
  With cell
   Range(cell(.Row, 2), Cells(.Row, 2)) = ">>"
   Range(cell(4, .Column), Cells(4, .Column)) = "V"
  End With
Next
   Application.ScreenUpdating = True
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
End If
End Sub

...zum Beitrag

Excel, Spalte rechts nebenan kopieren?

Hallo, wie kann ich per Excel VBA eine Range (eine Spalte) mit einer Zelle vergleichen und nach einem Match die Zelle direkt rechts neben der Range (eine Spalte) selektieren?

...zum Beitrag

VBA Laufzeitfehler/ Error/ Programm hängt sich auf?

Hallo zusammen,

Ich habe ein Makro geschrieben, mit welchem jeweils via Button eine neue Spalte eingefügt wird.

Über den Button Spalten entfernen wird die jeweils ausgewählte Spalte gelöscht.

Private Sub CmdSpaltePlus_Click() 'Test Spalte hinzufügen

Dim spalte, zeile As Integer

Application.ScreenUpdating = False

spalte = 4

Do Until Cells(2, spalte).Value = "Perfektion"

   spalte = spalte + 1

Loop

Columns("D:E").Copy

Columns(spalte).Insert Shift:=xlToRight

Range(Cells(2, spalte - 2), Cells(2, spalte + 1)).Merge

Range(Cells(4, spalte), Cells(4, spalte + 1)).Merge

Cells(3, spalte).Value = ""

Cells(3, spalte + 1).Value = ""

Cells(4, spalte).Value = ""

Cells(4, spalte + 1).Value = ""

zeile = 6

 

Do Until zeile = 1000

   If Left(Cells(zeile, 1).Value, 1) = "S" Then

        Cells(zeile, spalte).Value = ""

       Cells(zeile, spalte + 1).Value = ""

    End If

   zeile = zeile + 1

Loop

Application.ScreenUpdating = True

End Sub

 

Private Sub CmdPerfektionPlus_Click() 'Perfektion Spalte hinzufügen

Dim spalte, zeile As Integer

Application.ScreenUpdating = False

spalte = 4

Do Until Cells(2, spalte).Value = "F.n.B."

   spalte = spalte + 1

Loop

Columns("D:E").Copy

Columns(spalte).Insert Shift:=xlToRight

Range(Cells(2, spalte - 2), Cells(2, spalte + 1)).Merge

Range(Cells(4, spalte), Cells(4, spalte + 1)).Merge

Cells(3, spalte).Value = ""

Cells(3, spalte + 1).Value = ""

Cells(4, spalte).Value = ""

Cells(4, spalte + 1).Value = ""

zeile = 6

Do Until zeile = 1000

   If Left(Cells(zeile, 1).Value, 1) = "S" Then

        Cells(zeile, spalte).Value = ""

       Cells(zeile, spalte + 1).Value = ""

    End If

   zeile = zeile + 1

Loop

Application.ScreenUpdating = True

End Sub

Spalten löschen

Private Sub Kompetenzenentfernen_Click() 'Spalten löschen

ActiveSheet.Unprotect Password:="MNPS"

If Cells(5, ActiveCell.Column) = "Schicht" Or Cells(5, ActiveCell.Column) = "Nr." Or Cells(5, ActiveCell.Column) = "Name" Or Cells(3, ActiveCell.Column) = "A1" Or Cells(3, ActiveCell.Column) = "D1" Or Cells(9, ActiveCell.Column) = "." Or Cells(3, ActiveCell.Column) = "E1" Or Cells(3, ActiveCell.Column) = "F1" Or Cells(3, ActiveCell.Column) = "G1" Or Cells(3, ActiveCell.Column) = "H1" Or Cells(2, ActiveCell.Column) = "." Or Cells(1, ActiveCell.Column) = "Zielwert" Then

MsgBox "Spalte kann nicht gelöscht werden"

Else

Selection.EntireColumn.Delete Shift:=xlUp

End If

'ActiveSheet.Protect Password:="MNPS"

End Sub

Die Buttons funktionieren auch alle, nur leider kommt oft eine Laufzeitfehlerneldung oder das ganze Programm hängt sich auf wenn ich erst mit dem einen Button eine Spalte eingefügt habe und im Anschluss mit dem anderen Button eine Spalte einfügen.

Es funktioniert also leider nicht verlässlich. Hat jemand eine Idee woran das liegen könnte?

Vielen Dank im Voraus!

...zum Beitrag

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

...zum Beitrag

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

...zum Beitrag

Makro zum Zusammenfassen von Spalten

Hallo alle zusammen,

ich hab ein kleines Problem mit einem Makro, welches ich mir mit Hilfe diverser Quellen versucht habe auf meinen Fall zusammenzuschustern. Folgendermaßen kann man sich die Grundsituation vorstellen:

Ich habe in den Spalten D Und E ca 70 Zeilen mit Einträgen. Bis auf die Zellen 11 - 14 Ist die Spalte E leer. Also wollte ich ein Makro benutzen, welches die Spalte D wenn D und/oder E leer sind mit E zusammenfasst und sonst nicht.

Das soll dann auch für die Spalten F,G und H,I und immer soweiter klappen. Wer könnte mir Helfen und zeigen wo mein Fehler liegt denn bisher funktioniert das Makro nicht ganz so wie ich mir das vorgestellt habe.

Sub Formatierung()

Dim Zeile As Integer Dim Spalte As Integer

For Spalte = 4 To 256 Step 2
For Zeile = 1 To 100

If ((Not (IsEmpty(Cells(Spalte, Zeile)))) = True And IsEmpty(Cells(Spalte + 1, Zeile)) = True) Then
Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte + 1)).Merge
End If

If IsEmpty(Cells(Spalte, Zeile)) = True And IsEmpty(Cells(Spalte + 1, Zeile)) = True Then
Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte + 1)).Merge
End If

Next Zeile

Next Spalte

End Sub

So sieht das bisher aus. Für jede Hilfe vorab schonmal besten Dank

...zum Beitrag

Beim ändern einer bestimmten Zelle Makro erneut ausführen?

Hallo,

ich habe folgendes Anliegen: Ich möchte in Excel mit VBA etwas machen. Hier einmal der Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("j10")) Is Nothing Then
    Select Case Range("j10").Value
        Case "manuell"
            Range("s7:u7").ClearContents
        Case "Anfang & Ende"
            Range("s7").Value = Worksheets("PEPStauchung").Range("d2").Value
    End Select
End If
End Sub

Ich möchte, dass, wenn ich in Zelle S6 einen Wert ändere, das ganze erneut durchgeführt wird.

Wie binde ich das ein? Vielen Dank!!!

Syrena

...zum Beitrag

Was möchtest Du wissen?

Deine Frage stellen