Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1600to1604
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
Inhaltsverzeichnis

Zeile durchsuchen und Spalte dann kopieren

Zeile durchsuchen und Spalte dann kopieren
09.01.2018 08:49:19
MikeW
Guten Morgen,
ich schreibe gerade meine Bachelorarbeit und möchte in diesem Zuge eine Excel-Datei optimieren.
Es handelt sich um eine Tabelle mit Daten aus einer Anlage. Diese sind sehr unübersichtlich dargestellt.
Nun möchte ich auf einem anderen Reiter eine Vorlage erstellen, welches die benötigten Informationen übersichtlich und sortiert darstellt.
Die Anlage würde die ganzen Daten automatisch in den Reiter Rohdaten hineinkopieren.
Würde mich freuen wenn ihr mir beim erstellen des Makros unterstützen könnt.
Ich möchte in den Rohdaten die Zeile 4 beispielsweiße nach dem Wort "Datum" durchsuchen lassen, wenn das Wort "Datum" gefunden wurde, soll diese Spalte ab der Zeile 5 kopiert werden und in den Reiter "Vorlage" in die zweite Spalte ab der Zeile 5 eingefügt werden.
Diese Funktion würde ich dann für alle benötigten Informationen verwenden um diese übersichtlich und sortiert darzustellen.
Sie sollte am besten ohne einen Button funktionieren, so dass beim öffnen der Datei die Vorlage automatisch befüllt wird.
Im Voraus vielen Dank für eure Unterstützung.

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeile durchsuchen und Spalte dann kopieren
09.01.2018 10:10:12
UweD
Hallo
so?
in ein Modul
Sub dddd()
    Dim TB1, TB2, LR1 As Double, LR2 As Double, EZ1 As Integer, EZ2 As Integer
    Dim Arr, Z, Spalte As Integer
    
    Arr = Array("Datum", "Menge", "Leistung")  ' Suchbegriffe 
    
    Set TB1 = Sheets("Rohdaten")
    Set TB2 = Sheets("Vorlage")
    EZ1 = 4 'Zeile in der gesucht wird 
    EZ2 = 5 'Zielzeile 
    
    For Each Z In Arr
        With WorksheetFunction
            If .CountIf(TB1.Rows(EZ1), Z) > 0 Then 'Ist Suchbegriff da? 
                Spalte = .Match(Z, TB1.Rows(EZ1), 0) 'in welcher Spalte 
                LR1 = TB1.Cells(TB1.Rows.Count, Spalte).End(xlUp).Row 'letzte Zeile der Spalte 
                If LR1 > EZ1 Then 'sind Werte vorhanden? 
                
                    LR2 = .Max(EZ2, TB2.Cells(TB2.Rows.Count, Spalte).End(xlUp).Row)
                    
                    'Reset 
                    TB2.Cells(EZ2, Spalte).Resize(LR2 - EZ2 + 1).ClearContents
                
                    'Übertragen 
                    TB2.Cells(EZ2, Spalte).Resize(LR1 - EZ1).Value = _
                        TB1.Cells(EZ1 + 1, Spalte).Resize(LR1 - EZ1).Value
                End If
            Else
                MsgBox "Suchbegriff '" & Z & "' wurde nicht gefunden"
            End If
        End With
    Next
    
    
End Sub

LG UweD
Anzeige
AW: Zeile durchsuchen und Spalte dann kopieren
09.01.2018 10:52:15
UweD
Hab gerade gesehen, dass du ja in Spalte 2 (dann fortlaufend) beginnen möchtest
und automatisch startend.
dann versuch es so.
Code muss in "DieseArbeitsmappe"
Option Explicit

Private Sub Workbook_Open()
    Dim TB1, TB2, LR1 As Double, LR2 As Double, EZ1 As Integer, EZ2 As Integer
    Dim Arr, Z, Spalte As Integer, ESp2 As Integer
    
    Arr = Array("Datum", "Menge", "Leistung")  ' Suchbegriffe anpassen 
    
    Set TB1 = Sheets("Rohdaten")
    Set TB2 = Sheets("Vorlage")
    EZ1 = 4 'Zeile in der gesucht wird 
    EZ2 = 5 'Zielzeile 
    ESp2 = 2 'erste ZielSpalte 
    
    With WorksheetFunction
        LR1 = .Max(EZ1, TB1.Cells.SpecialCells(xlCellTypeLastCell).Row) 'letze Spalte des gesamten Blattes 
        LR2 = .Max(EZ2, TB2.Cells.SpecialCells(xlCellTypeLastCell).Row)
    
        'Reset inkl. Überschriften 
        TB2.Rows(EZ2 - 1).Resize(LR2 - EZ2 + 2).ClearContents
        
        If LR1 > EZ1 Then 'sind Werte vorhanden? 
    
            For Each Z In Arr
                If .CountIf(TB1.Rows(EZ1), Z) > 0 Then 'Ist Suchbegriff da? 
                    Spalte = .Match(Z, TB1.Rows(EZ1), 0) 'in welcher Spalte 
                
                    'Übertragen inkl. Überschrift 
                    TB2.Cells(EZ2 - 1, ESp2).Resize(LR1 - EZ1).Value = _
                        TB1.Cells(EZ1, Spalte).Resize(LR1 - EZ1 + 1).Value
                    
                    ESp2 = ESp2 + 1 'nächste Spalte 
                Else
                    MsgBox "Suchbegriff '" & Z & "' wurde nicht gefunden"
                End If
            Next
            MsgBox "Rohdaten übernommen!"
            
        Else
            MsgBox "Keine Rohdaten vorhanden!"
        End If
        
    End With
   
End Sub

LG UweD
Anzeige
AW: Zeile durchsuchen und Spalte dann kopieren
09.01.2018 13:26:04
MikeW
Hallo Uwe,
zu aller erst vielen Dank für dein Bemühen.
Ich habe versucht deinen Code auf meine Datei zu übertragen. Ich muss ehrlich sagen, dass ich mich nicht besonders gut auskenne.
Habe die Datei eingefügt, du würdest mir wirklich sehr helfen, wenn du es mir anpassen könntest.
https://www.herber.de/bbs/user/118807.xlsx
Als Code habe ich in das Modul1 folgenden Code eingefügt:
Option Explicit
Private Sub Workbook_Open()
Dim TB1, TB2, LR1 As Double, LR2 As Double, EZ1 As Integer, EZ2 As Integer
Dim Arr, Z, Spalte As Integer, ESp2 As Integer
Arr = Array(Benennung, Datum, Stufe, Typ)  ' Suchbegriffe anpassen
Set TB1 = Sheets(Rohdaten)
Set TB2 = Sheets(Vorlage)
EZ1 = 4 'Zeile in der gesucht wird
EZ2 = 4 'Zielzeile
ESp2 = 1 'erste ZielSpalte
With WorksheetFunction
LR1 = .Max(EZ1, TB1.Cells.SpecialCells(xlCellTypeLastCell).Row) 'letze Spalte des  _
gesamten Blattes
LR2 = .Max(EZ2, TB2.Cells.SpecialCells(xlCellTypeLastCell).Row)
'Reset inkl. Überschriften
TB2.Rows(EZ2 - 1).Resize(LR2 - EZ2 + 2).ClearContents
If LR1 > EZ1 Then 'sind Werte vorhanden?
For Each Z In Arr
If .CountIf(TB1.Rows(EZ1), Z) > 0 Then 'Ist Suchbegriff da?
Spalte = .Match(Z, TB1.Rows(EZ1), 0) 'in welcher Spalte
'Übertragen inkl. Überschrift
TB2.Cells(EZ2 - 1, ESp2).Resize(LR1 - EZ1).Value = _
TB1.Cells(EZ1, Spalte).Resize(LR1 - EZ1 + 1).Value
ESp2 = ESp2 + 1 'nächste Spalte
Else
MsgBox "Suchbegriff '" & Z & "' wurde nicht gefunden"
End If
Next
MsgBox "Rohdaten übernommen!"
Else
MsgBox "Keine Rohdaten vorhanden!"
End If
End With
End Sub
Vielen Dank
Gruß Michael
Anzeige
AW: Zeile durchsuchen und Spalte dann kopieren
09.01.2018 15:01:00
MikeW
Hallo UweD,
ich habe die Fehler entdeckt, wieso der Code bei mir nicht funktioniert hat.
Jetzt habe ich jedoch festgestellt, dass diese Funktion nicht genau dem entspricht was ich mir Vorgestellt habe. Ich habe es anfangs auch falsch beschrieben.
Mein Ziel ist es den Reiter "Vorlage" unterschiedlich zu Formatieren, sprich Farbgestaltung Schriftgröße und so weiter. Das eine nach meinen Vorstellungen leere Tabelle vorbereitet ist.
Nun möchte ich nach Begriffen im Reiter "Rohdaten" Zeile 4 durchsuchen und in diese Tabelle an den richtigen Ort kopieren.
Als Beispiel:
Ich suche nach den Begriffen Datum, Stufe, Typ, ... in Zeile 4 der Rohdaten.
Finde ich den Begriff Datum in Zeile 4 der Rohdaten, dann soll diese Spalte ab Zeile 5 (also ohne die Überschrift "Datum") kopiert werden und in den Reiter "Vorlage" in die dafür fix vorgesehene Spalte 1 ab Zeile 5 eingefügt werden.
Für die jeweiligen Begriffe Stufe, Typ, ... sind dann andere fix vorgesehene Spalte im Reiter "Vorlage" vorgesehen (siehe Datei) die ich dann im Makro hinterlegen möchte.
Wird ein Begriff beispielsweiße nicht gefunden, weil er in den Rohdaten nicht vorkommen, dann bleibt die dafür vorgesehene Spalte im Reiter "Vorlage" leer.
Ich habe die Datei mit einer Veranschaulichung der Tabelle im Reiter "Vorlage" hinzugefügt.
https://www.herber.de/bbs/user/118810.xlsx
Würdest mich wirklich sehr helfen !
Gruß Michael
Anzeige
AW: Zeile durchsuchen und Spalte dann kopieren
09.01.2018 15:04:39
UweD
Hallo
2 Fehler...
- Der Code muss in "DieseArbeitsmappe"
- Du hast einige Anführungszeichen vergessen
Userbild
LG UweD
AW: Zeile durchsuchen und Spalte dann kopieren
09.01.2018 15:12:56
MikeW
Genau diese zwei Fehler habe ich auch gefunden und behoben.
Nur leider wie im Kommentar geschrieben war das Makro nicht zielführend *mein Fehler sorry*.
Könntest du mir vielleicht dazu noch einmal helfen..
Würde mich wirklich freuen wenn ich es hinbekomme.
Gruß Michael
AW: Zeile durchsuchen und Spalte dann kopieren
09.01.2018 16:00:00
UweD
Ok.
jetzt werden die eingetragenen Suchbegriffe der Vorlage gelesen und nacheinander bearbeitet.
(Programm habe ich durch Programmnummer angeglichen)
Option Explicit
Private Sub Workbook_Open()
    Dim TB1, TB2, LR1 As Double, LR2 As Double, LC As Integer, EZ1 As Integer, EZ2 As Integer
    Dim Arr, Z, Spalte As Integer, ESp2 As Integer
    
    Set TB1 = Sheets("Rohdaten")
    Set TB2 = Sheets("Vorlage")
    EZ1 = 4 'Zeile in der gesucht wird 
    EZ2 = 5 'Zielzeile für Daten 
    ESp2 = 1 'erste ZielSpalte 
    
    With TB2
        LC = .Cells(EZ2 - 1, .Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile 
        Arr = .Cells(EZ2 - 1, 1).Resize(1, LC) 'liest die Suchbegriffe 
    End With
    
    With WorksheetFunction
        LR1 = .Max(EZ1, TB1.Cells.SpecialCells(xlCellTypeLastCell).Row) 'letze Spalte des gesamten Blattes 
        LR2 = .Max(EZ2, TB2.Cells.SpecialCells(xlCellTypeLastCell).Row)
    
        'Reset 
        TB2.Rows(EZ2).Resize(LR2 - EZ2 + 1).ClearContents
        
        If LR1 > EZ1 Then 'sind Werte vorhanden? 
    
            For Each Z In Arr
                If .CountIf(TB1.Rows(EZ1), Z) > 0 Then 'Ist Suchbegriff da? 
                    Spalte = .Match(Z, TB1.Rows(EZ1), 0) 'in welcher Spalte 
                
                    'Übertragen inkl. Überschrift 
                    TB2.Cells(EZ2, ESp2).Resize(LR1 - EZ1 + 1).Value = _
                        TB1.Cells(EZ1 + 1, Spalte).Resize(LR1 - EZ1 + 1).Value
                    
                Else
                    MsgBox "Suchbegriff '" & Z & "' wurde nicht gefunden"
                End If
                ESp2 = ESp2 + 1 'nächste Spalte 
            Next
            MsgBox "Rohdaten übernommen!"
            
        Else
            MsgBox "Keine Rohdaten vorhanden!"
        End If
        
    End With
   
End Sub

LG UweD
Anzeige
AW: Zeile durchsuchen und Spalte dann kopieren
09.01.2018 16:21:13
MikeW
Hallo UweD,
wirklich, vielen vielen Dank für deine Bemühungen. Leider kann es so aber nicht funktionieren :(
Nach den Begriffen, nach denen ich in Zeile 4 der "Rohdaten" suchen möchte stimmen nicht immer mit den Überschriften in der Tabelle überein. Ansonsten würde dein Makro klasse funktionieren. Die tatsächlichen Suchbegriffe möchte ich dann erst im Makro hinterlegen.
Ich versuche es mal, den Code in "normaler Sprache zu schreiben":D. Hoffe es hilft dir weiter und du kannst besser verstehen was ich benötige.
Option Explicit
Private Sub Workbook_Open()
'Suchbegriffe definieren
Dim "Datum" As String
Dim "Stufe" As String
'Abfrage in Reiter "Rohdaten" in Zeile 4 durchführen ob Wort "Datum" vorhanden
If "Datum" in Reiter "Rohdaten" in Zeile 4 Then
Kopieren dieser Spalte ab Zeile 5
Einfügen in Reiter "Vorlage" in Spalte A ab Zeile 4
Else
Nichts soll passieren
'Abfrage in Reiter "Rohdaten" in Zeile 4 durchführen ob Wort "Stufe" vorhanden
If "Stufe" in Reiter "Rohdaten" in Zeile 4 Then
Kopieren dieser Spalte ab Zeile 5
Einfügen in Reiter "Vorlage" in Spalte B ab Zeile 4
Else
Nichts soll passieren
End Sub
So würde ich für jeden Suchbegriff eine If Funktion einfügen.
Ich hoffe dieses Beispiel hilft dir weiter, ich versuche es schon den ganzen Tag aber komme leider nicht weiter...
Noch einmal vielen Dank im Voraus !
Anzeige
AW: Zeile durchsuchen und Spalte dann kopieren
09.01.2018 17:03:06
UweD
So.
also wieder mit vordefinierten Suchbegriffen
Option Explicit
Private Sub Workbook_Open()
    Dim TB1, TB2, LR1 As Double, LR2 As Double, LC As Integer, EZ1 As Integer, EZ2 As Integer
    Dim Arr, Z, Spalte As Integer, ESp2 As Integer
    
    Set TB1 = Sheets("Rohdaten")
    Set TB2 = Sheets("Vorlage")
    EZ1 = 4 'Zeile in der gesucht wird 
    EZ2 = 5 'Zielzeile für Daten 
    ESp2 = 1 'erste ZielSpalte 
    
    Arr = Array("Datum", "Stufe", "Typ") 'die Suchbegriffe für Rohdaten 
    
    With WorksheetFunction
        LR1 = .Max(EZ1, TB1.Cells.SpecialCells(xlCellTypeLastCell).Row) 'letze Spalte des gesamten Blattes 
        LR2 = .Max(EZ2, TB2.Cells.SpecialCells(xlCellTypeLastCell).Row)
    
        'Reset ohne Überschriften 
        TB2.Rows(EZ2).Resize(LR2 - EZ2 + 1).ClearContents
        
        If LR1 > EZ1 Then 'sind Werte vorhanden? 
    
            For Each Z In Arr
                If .CountIf(TB1.Rows(EZ1), Z) > 0 Then 'Ist Suchbegriff in Zeile EZ1 =4 vorhanden? 
                    Spalte = .Match(Z, TB1.Rows(EZ1), 0) 'in welcher Spalte steht der Begriff 
                
                    'Übertragen ohne Überschrift 
                    TB2.Cells(EZ2, ESp2).Resize(LR1 - EZ1 + 1).Value = _
                        TB1.Cells(EZ1 + 1, Spalte).Resize(LR1 - EZ1 + 1).Value
                    
                Else
                    'Fehlermeldung, wenn der Suchbegriff in Rohdaten nicht gefunden wird 
                    MsgBox "Suchbegriff '" & Z & "' wurde nicht gefunden"
                End If
                
                ESp2 = ESp2 + 1 'nächste Spalte 
                
            Next
            'Fertig 
            MsgBox "Rohdaten übernommen!"
            
        Else
            'Keine Daten unter Zeile EZ1 =4 vorhanden 
            MsgBox "Keine Rohdaten vorhanden!"
        End If
        
    End With
   
End Sub

LG UweD
Anzeige
AW: Zeile durchsuchen und Spalte dann kopieren
09.01.2018 22:07:09
MikeW
Hallo UweD,
ja nur das Problem an diesem Makro ist, dass ich nicht bestimmen kann, in welche Spalte es kopiert werden soll.
Aktuell werden sie ja nach der Reihenfolge der Suchbegriffe im Makro in den Reiter "Vorlage" kopiert.
Ich will in dem Makro festlegen können, dass ein Suchbegriff in Spalte XY im Reiter "Vorlage" hinein kopiert werden soll.
Das beispielsweiße "Datum" immer in Spalte A kopiert werden soll und "Stufe" in Spalte E.
Ansonsten würde alles wunderbar passen.
Würde mich sehr freuen, wenn wir das hinbekommen würden :)
Wünsche dir noch einen schönen Abend !
Anzeige
AW: Zeile durchsuchen und Spalte dann kopieren
10.01.2018 08:54:40
UweD
Hallo nochmal
dann mit 2 Arrays
Das 1. mit den Suchbegriffen, das 2. mit den Spaltennummern, wo die Daten eingefügt werden sollen.
(Anzahl muss dann gleich sein)
Option Explicit
Private Sub Workbook_Open()
    Dim TB1, TB2, LR1 As Double, LR2 As Double, LC As Integer, EZ1 As Integer, EZ2 As Integer
    Dim ArrBegr, ArrWo, Z As Integer, Spalte As Integer
    
    Set TB1 = Sheets("Rohdaten")
    Set TB2 = Sheets("Vorlage")
    EZ1 = 4 'Zeile in der gesucht wird 
    EZ2 = 5 'Zielzeile für Daten 
    
    ArrBegr = Array("Datum", "Stufe", "Typ") 'die Suchbegriffe für Rohdaten 
    ArrWo = Array(1, 2, 4) 'die Einfügespalten für die Suchbegriffe 
    
    With WorksheetFunction
        LR1 = .Max(EZ1, TB1.Cells.SpecialCells(xlCellTypeLastCell).Row) 'letze Spalte des gesamten Blattes 
        LR2 = .Max(EZ2, TB2.Cells.SpecialCells(xlCellTypeLastCell).Row)
    
        'Reset ohne Überschriften 
        TB2.Rows(EZ2).Resize(LR2 - EZ2 + 1).ClearContents
        
        If LR1 > EZ1 Then 'sind Werte vorhanden? 
    
            For Z = Lbound(ArrBegr, 1) To Ubound(ArrBegr, 1)
                If .CountIf(TB1.Rows(EZ1), ArrBegr(Z)) > 0 Then 'Ist Suchbegriff in Zeile EZ1 =4 vorhanden? 
                    Spalte = .Match(ArrBegr(Z), TB1.Rows(EZ1), 0) 'in welcher Spalte steht der Begriff 
                
                    'Übertragen ohne Überschrift 
                    TB2.Cells(EZ2, ArrWo(Z)).Resize(LR1 - EZ1 + 1).Value = _
                        TB1.Cells(EZ1 + 1, Spalte).Resize(LR1 - EZ1 + 1).Value
                    
                Else
                    'Fehlermeldung, wenn der Suchbegriff in Rohdaten nicht gefunden wird 
                    MsgBox "Suchbegriff '" & ArrBegr(Z) & "' wurde nicht gefunden"
                End If
                
            Next
            'Fertig 
            MsgBox "Rohdaten übernommen!"
            
        Else
            'Keine Daten unter Zeile EZ1 =4 vorhanden 
            MsgBox "Keine Rohdaten vorhanden!"
        End If
        
    End With
   
End Sub
LG UweD
Anzeige
AW: Zeile durchsuchen und Spalte dann kopieren
10.01.2018 17:26:29
MikeW
Guten Abend UweD,
vielen Dank ! Genau so habe ich es mir vorgestellt. Konnte es auch bereits komplett in mein kleines Projekt integrieren.
Jedoch ist mir eine notwendige Optimierung aufgefallen, bei der ich hoffe, dass du mir dabei helfen kannst.
In den Rohdaten gibt es mehrmals Spalten, die nicht vollständig befüllt sind. Beispielsweise gibt es Spalten mit den Überschriften "Datum" und "Date".
In einer Zeile der beiden Überschriften sind niemals beide Spalten gleichzeitig befüllt. Entweder gibt es einen Eintrag bei "Datum" oder bei "Date".
Nun habe ich die Überlegung, bevor die Spalten in den Reiter "Vorlage" kopiert wird, beide Spalten zu überlagern und erst anschließend dann in eine einzige Spalte im Reiter "Vorlage" zu kopieren.
Denkst du hierzu gibt es eine Möglichkeit und du könntest mir helfen?
Wünsche dir einen schönen Abend !
AW: Zeile durchsuchen und Spalte dann kopieren
12.01.2018 11:10:37
UweD
Hallo nochmal
hab das für Datum / Date eingebaut.
Option Explicit
Private Sub Workbook_Open()
    Dim TB1, TB2, LR1 As Double, LR2 As Double, LC As Integer, EZ1 As Integer, EZ2 As Integer
    Dim ArrBegr, ArrWo, Z As Integer, Spalte As Integer, SpTmp As Integer
    
    Set TB1 = Sheets("Rohdaten")
    Set TB2 = Sheets("Vorlage")
    EZ1 = 4 'Zeile in der gesucht wird 
    EZ2 = 5 'Zielzeile für Daten 
    
    ArrBegr = Array("Datum", "Stufe", "Typ") 'die Suchbegriffe für Rohdaten 
    ArrWo = Array(1, 2, 4) 'die Einfügespalten für die Suchbegriffe 
    
    With WorksheetFunction
        LR1 = .Max(EZ1, TB1.Cells.SpecialCells(xlCellTypeLastCell).Row) 'letze Spalte des gesamten Blattes 
        LR2 = .Max(EZ2, TB2.Cells.SpecialCells(xlCellTypeLastCell).Row)
    
    
    
        'Reset ohne Überschriften 
        TB2.Rows(EZ2).Resize(LR2 - EZ2 + 1).ClearContents
        
        If LR1 > EZ1 Then 'sind Werte vorhanden? 
    
            For Z = Lbound(ArrBegr, 1) To Ubound(ArrBegr, 1)
                If .CountIf(TB1.Rows(EZ1), ArrBegr(Z)) > 0 Then 'Ist Suchbegriff in Zeile EZ1 =4 vorhanden? 
                    Spalte = .Match(ArrBegr(Z), TB1.Rows(EZ1), 0) 'in welcher Spalte steht der Begriff 
                    
                    'Datum / Date normieren 
                    If ArrBegr(Z) = "Datum" Then
                        If .CountIf(TB1.Rows(EZ1), "Date") > 0 Then
                            SpTmp = .Match("Date", TB1.Rows(EZ1), 0)
                            With TB1
                       
                                LC = .Cells.SpecialCells(xlCellTypeLastCell).Column + 1 'nächste freie Spalte des gesamten Blattes 
                                
                                'Hilfsspalte mit Formel; Wenn kein Datum dann nimm Date 
                                .Range(.Cells(EZ1 + 1, LC), .Cells(LR1, LC)).FormulaR1C1 = _
                                    "=IF(RC" & Spalte & "="""",RC" & SpTmp & ",RC" & Spalte & ")"
                                
                                Spalte = LC
                                MsgBox "Datum / Date vereint"
                            End With
                        Else
                            MsgBox "Spalte 'Date' wurde nicht gefunden"
                        End If
                    End If
                    
                    
                    'Übertragen ohne Überschrift 
                    TB2.Cells(EZ2, ArrWo(Z)).Resize(LR1 - EZ1 + 1).Value = _
                        TB1.Cells(EZ1 + 1, Spalte).Resize(LR1 - EZ1 + 1).Value
                        
                    'Temoräre DatumSpalte löschen 
                    If LC > 0 Then TB1.Columns(LC).ClearContents
                    
                Else
                    'Fehlermeldung, wenn der Suchbegriff in Rohdaten nicht gefunden wird 
                    MsgBox "Suchbegriff '" & ArrBegr(Z) & "' wurde nicht gefunden"
                End If
                
            Next
            'Fertig 
            MsgBox "Rohdaten übernommen!"
            
        Else
            'Keine Daten unter Zeile EZ1 =4 vorhanden 
            MsgBox "Keine Rohdaten vorhanden!"
        End If
        
    End With
   
End Sub


LG UweD

320 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige