Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 09:08:00
Export alle Tabellenblätter als csv - in bestimmten Ordner
26.04.2024 08:56:40
Über alle Spalten nur €-Werte zählen
26.04.2024 08:08:24
Pivot Vormonatsveränderung
26.04.2024 07:54:11
nur den ersten Eintrag in spalte zählen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1568to1572
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1568to1572
1568to1572
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Help, I need somebody, Help! :-)

Help, I need somebody, Help! :-)
27.07.2017 12:09:29
Lizz
Hallo!
ich möchte gerne immer, wenn in der Spaltenüberschrift der Wert "DEC" vorkommt, dass dahinter eine leere Spalte eingefügt wird, in der die Werte aus Spalte A eingefügt werden.
Geht so etwas?

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Help, I need somebody, Help! :-)
27.07.2017 12:52:31
Daniel
Hi
Sub test()
Dim sp As Long
For sp = Cells.SpecialCells(xlCellTypeLastCell).Column To 2 Step -1
If Cells(1, sp).Value Like "*DEC*" Then
Columns(1).Copy
Columns(sp + 1).Insert
End If
Next
End Sub

Gruß Daniel
AW: Help, I need somebody, Help! :-)
27.07.2017 13:11:41
Lizz
Wow!
Danke für die vielen Antworten, ihr seid die Helden des VBA-Alltags! :-)
@ Daniel: Klappt einwandfrei! Danke!!
AW: Help, I need somebody, Help! :-)
27.07.2017 12:55:46
UweD
Hallo
so geht das...
 Sub DEC_ADD()
    On Error GoTo Fehler
    Dim TB, i As Integer, LC As Integer, LR As Long
    Set TB = Sheets("Tabelle1")
    
    LC = TB.Cells(1, TB.Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile 
    LR = TB.Cells(TB.Rows.Count, "A").End(xlUp).Row 'letzte Zeile der Spalte 
    For i = LC To 2 Step -1
        If TB.Cells(1, i) = "DEC" Then
            TB.Columns(i + 1).Insert Shift:=xlToRight
            TB.Range(TB.Cells(2, i + 1), TB.Cells(LR, i + 1)) = _
                TB.Range(TB.Cells(2, 1), TB.Cells(LR, 1)).Value

        End If
    Next
    
    '*** Fehlerbehandlung 
    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD
Anzeige
AW: Help, I need somebody, Help! :-)
27.07.2017 12:58:59
mmat
ungefähr so?
Sub zusatzspalte()
Dim c As Long
c = Cells(1, 16000).End(xlToLeft).Column
While (c > 1)
If UCase(Cells(1, c)) = "DEC" Then
Columns(1).Copy
Cells(1, c + 1).Insert
End If
c = c - 1
Wend
End Sub

AW: Help, I need somebody, Help! :-)
27.07.2017 13:02:23
mmat
Hi Lizz
Wow, jetzt will aber auch wissen, welcher der Vorschläge zum Einsatz kommt :-)
vg, MM
Das ist wie bei der
27.07.2017 15:30:24
lupo1
Fortpflanzung: Die schnellste Kaulquappe siegt.
AW: Das ist wie bei der
27.07.2017 15:38:39
mmat
Tja, nur im Gegensatz zu den Kaulquappen gibt's hier vielleicht nen 2, 3, ... nten Versuch :-D
AW: Help, I need somebody, Help! :-)
27.07.2017 13:03:21
KlausF
Hallo Lizz,
wenn die Spaltenüberschriften in Zeile 1 stehen:
Sub SpalteEinfuegen()
Dim i As Integer
Dim lastCol As Integer
Dim lastRow As Long
lastRow = ActiveSheet.Cells.Cells(Rows.Count, "A").End(xlUp).Row
lastCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column '1 = Spalte A, 2 = Spalte B  _
usw.
Application.ScreenUpdating = False
For i = lastCol To 1 Step -1
If InStr(Cells(1, i), "DEC") > 0 Then
Cells(1, i + 1).EntireColumn.Insert
Range("A1:A" & lastRow).Copy Destination:=Cells(1, i + 1)
End If
Next i
End Sub
Gruß
Klaus
Anzeige
O gott ... bin ja viel zu spät ... :-)
27.07.2017 13:04:54
KlausF

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige