ZielSpalte = 1
For Spalte = 1 To .UsedRange.Columns.Count
If .Cells(5, Spalte).Value = "Schichten bis zum 31.05.2020" Then
.Columns(Spalte).Copy Destination:=Worksheets("Basis").Columns(ZielSpalte)
ZielSpalte = ZielSpalte + 1
End If
Next Spalte
If Left$(.Cells(5, Spalte), 17).Value = "Schichten bis zum" Then
Der Verweis-Punkt vor "Cells" stammt von dir!Sub Schaltfläche1_Klicken()
Dim raFund As Range, loSpalte As Long
With Worksheets("Tabelle1")
Set raFund = .Rows(5).Find(what:="Schichten bis zum", _
LookIn:=xlValues, lookat:=xlPart)
If Not raFund Is Nothing Then
loSpalte = raFund.Column
MsgBox loSpalte
End If
End With
Set raFund = Nothing
End Sub
Gruß WernerOption Explicit
Sub Schaltfläche1_Klicken()
Dim raFund As Range, loZielspalte
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
Set raFund = .Rows(5).Find(what:="Schichten bis zum", LookIn:=xlValues, _
lookat:=xlPart)
If Not raFund Is Nothing Then
.Columns(raFund.Column).Copy
With Worksheets("Basis")
loZielspalte = .Cells(5, .Columns.Count).End(xlToLeft).Offset(, 1).Column
If .Cells(5, 1) = "" Then loZielspalte = 1
.Columns(loZielspalte).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End With
End If
End With
Set raFund = Nothing
End Sub
Gruß WernerDie erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen