Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Help, I need somebody, Help! :-)

Forumthread: 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?
Anzeige

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!!
Anzeige
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
Anzeige
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
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige