Live-Forum - Die aktuellen Beiträge
Datum
Titel
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
18.04.2024 18:04:29
Formel fehler Wert#
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1680to1684
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
1680to1684
1680to1684
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Spaltenüberschriften suchen und Spalten kopieren

Spaltenüberschriften suchen und Spalten kopieren
17.03.2019 16:41:31
Bauer
Hallo Zusammen.
Ich bin neu hier, habe aber schon viel durch try and error aus den Foren gelernt. Ich habe Daten von einer Sortiermaschine (für fast jeden Tag eine) als csv die ich in eine Exceldatei einlesen möchte (jeden Tag in eigenes Blatt). Dabei verändert sich die Position der Daten und auch die Anzahl der zu kopierenden Daten. Ich habe schon einiges hinbekommen, wenn ich aber jetzt für alle Sortierungen die Abfrage laufen lasse und der Suchtext nicht vorkommt hängt das MAkro. Ich denke das es sicherlich deutlich eleganter geht, aber ich bin mit meiner Lösung bisher schon zufrieden. Ich bräuchte jetzt nur Hilfe wie ich nicht vorhandene Suchbegriffe überspringe.
Vielen Dank für die Hilfe
Workbooks.Open Filename:="D:\Daten\Lang_0404.csv", Local:=True
Range("A1").Select
Dim rngStart As Range
Dim rngEnde As Range
Dim rngStart2 As Range
Dim rngEnde2 As Range
Dim Sort1 As Range
Dim Sort2 As Range
Dim Sort3 As Range
Dim Sort4 As Range
Dim Sort5 As Range
Dim Sort6 As Range
Dim Sort7 As Range
Dim Sort8 As Range
Dim Sort9 As Range
Dim Sort10 As Range
Dim Sort11 As Range
Dim Sort12 As Range
Dim Sort13 As Range
Dim Sort14 As Range
Dim Sort15 As Range
Dim Sort16 As Range
Dim Sort17 As Range
Dim Sort18 As Range
Dim Sort19 As Range
Dim Sort20 As Range
Dim Sort21 As Range
Dim ws As Worksheet, wsZiel As Worksheet
Dim rngZelle As Range
Dim rngBereich As Range
Set ws = Worksheets("lang_0404")
Set rngStart = Columns(1).Find(What:="Anzeige der einzelnen Sortierungen als kg")
Set rngEnde = Columns(1).Find(What:="Anzeige der einzelnen Sortierungen als Anteile in Prozent des Gewichtes")
Set TransStart = Columns(1).Find(What:="Gesamtstecherlohn:")
Set transende = Columns(1).Find(What:="Nr,")
Set Sort1 = Columns(2).Find(What:="Tabelle_01 I weiss 30-36")
Set Sort2 = Columns(2).Find(What:="Tabelle_01 I weiss 25-30")
Set Sort3 = Columns(2).Find(What:="Tabelle_01 I weiss 21-25")
Set Sort4 = Columns(2).Find(What:="Tabelle_01 I weiss 16-21")
Set Sort5 = Columns(2).Find(What:="Tabelle_01 I weiss 14+")
Set Sort6 = Columns(2).Find(What:="Tabelle_01 II weiss 16-25")
Set Sort7 = Columns(2).Find(What:="Tabelle_01 II weiss 14+")
Set Sort8 = Columns(2).Find(What:="Tabelle_01 I Vio 16-26")
Set Sort9 = Columns(2).Find(What:="Tabelle_01 II Ws/Vio 30-36")
Set Sort10 = Columns(2).Find(What:="Tabelle_01 II Ws/Vio 25-30")
Set Sort11 = Columns(2).Find(What:="Tabelle_01 II Ws/Vio 21-25")
Set Sort10 = Columns(2).Find(What:="Tabelle_01 II Ws/Vio 25-30")
Set Sort11 = Columns(2).Find(What:="Tabelle_01 II Ws/Vio 21-25")
Set Sort12 = Columns(2).Find(What:="Tabelle_01 II Ws/Vio 16-21")
Set Sort13 = Columns(2).Find(What:="Tabelle_01 II Ws/Vio 14+")
Set Sort14 = Columns(2).Find(What:="Tabelle_01 I Köpfe")
Set Sort15 = Columns(2).Find(What:="Tabelle_01 II Köpfe")
Set Sort16 = Columns(2).Find(What:="Tabelle_01 Rest")
Set Sort17 = Columns(2).Find(What:="Tabelle_10 I 12 16")
Set Sort18 = Columns(2).Find(What:="Tabelle_10 I 8 12")
Set Sort19 = Columns(2).Find(What:="Tabelle_10 II 12+")
Set Sort20 = Columns(2).Find(What:="Tabelle_10 II 8+")
Set Sort21 = Columns(2).Find(What:="nicht zugeordnet")
Range(rngStart.Offset(2, 0), rngEnde.Offset(-3, 0)).Copy
'finde Zeile mit dem Text zu rngStart und beginne 2 Zeilen Später zu markieren bis Text rngEnde 3 zeilen vorher
ActiveWindow.ActivateNext
Range("A5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range(rngStart.Offset(2, 1), rngEnde.Offset(-3, 2)).Copy
ActiveWindow.ActivateNext
Range("E5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("D4").Copy
ActiveWindow.ActivateNext
Range("d5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("d16").Select
Dim Zeile As Double
Const Spalte As Integer = 1
Zeile = 16
With ActiveSheet
Do While .Cells(Zeile, Spalte) ""
ActiveCell.Formula = "=TRIM(RC[-2])"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Cut
ActiveCell.Offset(0, -2).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 2).Range("A1").Select
Zeile = Zeile + 1
Loop
End With
Range(TransStart.Offset(3, 0), transende.Offset(-2, 1)).Copy
'Transponiere Bereich ab Transstart plus 3 Zeilen bis Transende minus 2 Zeilen plus 1 Spalte
ActiveCell.Offset(1, 2).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
ActiveCell.Offset(1, -1).Range("A1").Select
Cells.Find(What:="Tabelle_01 I weiss 30-36", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("i5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 I weiss 25-30", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("j5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 I weiss 21-25", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("k5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 I weiss 16-21", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("l5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 I weiss 14+", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("m5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 II weiss 16-25", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("n5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 II weiss 14+", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("o5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 I vio 16-26", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("p5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 II ws/Vio 30-36", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("q5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 II ws/Vio 25-30", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("r5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 II ws/Vio 21-25", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("s5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 II ws/Vio 16-21", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("t5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 II ws/Vio 14+", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("u5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 I K?pfe", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("v5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 II K?pfe", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("w5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_01 Rest", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("x5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_10 I 12 16", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("y5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_10 I 8 12", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("z5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_10 II 12+", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("aa5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="Tabelle_10 II 8+", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("ab5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
Cells.Find(What:="nicht zugeordnet", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Range("ac5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("A1").Select
Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True). _
Activate
ActiveCell.Offset(1, 5).Select
End Sub

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spaltenüberschriften suchen und Spalten kopieren
17.03.2019 17:14:24
onur
"die ich in eine Exceldatei einlesen möchte (jeden Tag in eigenes Blatt" - das ist schon mal der grösste Fehler - würdest du nur ein Blatt nehmen, bräuchtest du nur nach Datum sortieren/filtern lassen und könntest 90% deines Codes sparen.
Dein Code besteht sowieso nur aus unzähligen Wiederholungengen von fast identischen Codefragmenten - noch nie was von Schleifen gehört?
AW: Spaltenüberschriften suchen und Spalten kopieren
17.03.2019 18:21:24
Bauer
Hallo Onur
wie gesagt bin ich bescheidener Anfänger und eigentlich doch recht zufrieden mit dem was ich erreicht habe. Da ich aber an dieser Stelle nicht richtig weiterkomme und mir denke das es auch einfacher geht habe ich mich dazu entschlossen die Anfrage zu stellen.
Es geht hier bislang noch nicht die verschiedenen Dateien in verschiedene Register zu kopieren. Ich bin noch an dem Punkt die verschiedenen Sortierungen an die richtige Stelle in der Exceldatei zu kopieren.
Danke trotzdem
Gruß Bauer
Anzeige
AW: Spaltenüberschriften suchen und Spalten kopieren
17.03.2019 23:48:06
fcs
Hallo Bauer,
wenn die auch keine Treffer-Zelle ergeben kann dann muss man mit Set arbeiten, um die Trefferzelle einer Objectvariablen zuzuweisen.
z.B, 
Set rngSuche = Cells.Find(What:="Suchbegriff", After:=ActiveCell, Lookin:=xlValues, _   ++
Lookat:=xlwhole)
Dannach kann man prüfen, ob die Variable ein Objekt enthält 
If Not rngSuche is Nothing Then
rngSuche.Activate
End If

Leider hast du den guten Ansatz mit Objektvariablen für die Tabellenblätter zu arbeiten irgendwann aufgegeben und den mit dem Recorder aufgezeichneten Code verwendet/eingebaut. das mach den Code unübersichtlich und manchmal schwierig naxhvollziehbar.
Ich hab mal Onurs Vorschlag umzusetzen und eine For-Next-Schleife für daqs Kopieren zu erstellen - natürlich ungetestet.
Wenn man jetzt die beiden Dateien/Arbeitsmappen und Tabellenblättern entsprchenden Variablen zuweist. Dann kann man das weiter optimieren und praktisch komplett auf die Activate, Seelction und Select verzichten.
LG
Franz
Sub aaa()
Workbooks.Open Filename:="D:\Daten\Lang_0404.csv", Local:=True
Range("A1").Select
Dim rngStart As Range
Dim rngEnde As Range
Dim rngStart2 As Range
Dim rngEnde2 As Range
'nicht weiter verwendete Variablen gelöscht
Dim ws As Worksheet, wsZiel As Worksheet
Dim rngZelle As Range
Dim rngBereich As Range
Dim TransStart As Range, TransEnde As Range
Set ws = Worksheets("lang_0404")
Set rngStart = Columns(1).Find(What:="Anzeige der einzelnen Sortierungen als kg")
Set rngEnde = Columns(1).Find(What:="Anzeige der einzelnen Sortierungen als Anteile in Prozent  _
des Gewichtes")
Set TransStart = Columns(1).Find(What:="Gesamtstecherlohn:")
Set transende = Columns(1).Find(What:="Nr,")
'Anweisungen gelöscht, da Ergebnis nicht weiter verwendet wird
Range(rngStart.Offset(2, 0), rngEnde.Offset(-3, 0)).Copy
'finde Zeile mit dem Text zu rngStart und beginne 2 Zeilen Später zu markieren bis Text rngEnde  _
3 zeilen vorher
ActiveWindow.ActivateNext
Range("A5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range(rngStart.Offset(2, 1), rngEnde.Offset(-3, 2)).Copy
ActiveWindow.ActivateNext
Range("E5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("D4").Copy
ActiveWindow.ActivateNext
Range("d5").Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
Range("d16").Select
Dim Zeile As Double
Const Spalte As Integer = 1
Zeile = 16
With ActiveSheet
Do While .Cells(Zeile, Spalte)  ""
ActiveCell.Formula = "=TRIM(RC[-2])"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Cut
ActiveCell.Offset(0, -2).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 2).Range("A1").Select
Zeile = Zeile + 1
Loop
End With
Range(TransStart.Offset(3, 0), transende.Offset(-2, 1)).Copy
'Transponiere Bereich ab Transstart plus 3 Zeilen bis Transende minus 2 Zeilen plus 1 Spalte
ActiveCell.Offset(1, 2).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
ActiveCell.Offset(1, -1).Range("A1").Select
Dim varSuch, lngSpa As Long
Range("A1").Select
Set rngStart = Cells.Find(What:="Nr,", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
For lngSpa = 9 To 29 ' I is AC
varSuch = ""
rngStart.Offset(1, 5).Select
Select Case lngSpa
Case 9: varSuch = "Tabelle_01 I weiss 30-36"
Case 10: varSuch = "Tabelle_01 I weiss 25-30"
Case 11: varSuch = "Tabelle_01 I weiss 21-25"
Case 12: varSuch = "Tabelle_01 I weiss 16-21"
Case 13: varSuch = "Tabelle_01 I weiss 14+"
Case 14: varSuch = "Tabelle_01 II weiss 16-25"
Case 15: varSuch = "Tabelle_01 II weiss 14+"
Case 16: varSuch = "Tabelle_01 I vio 16-26"
Case 17: varSuch = "Tabelle_01 II ws/Vio 30-36"
Case 18: varSuch = "Tabelle_01 II ws/Vio 25-30"
Case 19: varSuch = "Tabelle_01 II ws/Vio 21-25"
Case 20: varSuch = "Tabelle_01 II ws/Vio 16-21"
Case 21: varSuch = "Tabelle_01 II ws/Vio 14+"
Case 22: varSuch = "Tabelle_01 I K?pfe"
Case 23: varSuch = "Tabelle_01 II K?pfe"
Case 24: varSuch = "Tabelle_01 Rest"
Case 25: varSuch = "Tabelle_10 I 12 16"
Case 26: varSuch = "Tabelle_10 I 8 12"
Case 27: varSuch = "Tabelle_10 II 12+"
Case 28: varSuch = "Tabelle_10 II 8+"
Case 29: varSuch = "nicht zugeordnet"
End Select
If varSuch  "" Then
Set rngZelle = Cells.Find(What:=varSuch, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
If Not rngZelle Is Nothing Then
rngZelle.Activate
ActiveCell.Offset(3, 0).Select
With ActiveCell
Range(Cells(.Row, .Column), Cells(325, .Column)).Copy
End With
ActiveWindow.ActivateNext
Cells(5, lngSpa).Select
ActiveSheet.Paste
ActiveWindow.ActivateNext
End If
End If
Next
rngStart.Offset(1, 5).Select
End Sub
Versuch dein Makro ohne die Activate, Selection und Select umzusetzen.

Sub bbb()
Dim wkbZiel As Workbook
Dim wkbCSV As Workbook
Dim rngStart As Range
Dim rngEnde As Range
'nicht weiter verwendete Variablen gelöscht
Dim ws As Worksheet, wsZiel As Worksheet
Dim rngZelle As Range
Dim rngBereich As Range
Dim TransStart As Range, TransEnde As Range
Dim varSuch, lngSpa As Long
Set wkbZiel = ActiveWorkbook
Set wsZiel = ActiveSheet
Workbooks.Open Filename:="D:\Daten\Lang_0404.csv", Local:=True
Set wkbCSV = ActiveWorkbook
Set ws = wkbCSV.Worksheets(1)
Range("A1").Select
With ws
'finde Zeile mit dem Text zu rngStart und beginne 2 Zeilen Später zu markieren bis Text  _
rngEnde 3 zeilen vorher
Set rngStart = .Columns(1).Find(What:="Anzeige der einzelnen Sortierungen als kg")
Set rngEnde = .Columns(1).Find(What:= _
"Anzeige der einzelnen Sortierungen als Anteile in Prozent des Gewichtes")
Set TransStart = .Columns(1).Find(What:="Gesamtstecherlohn:")
Set TransEnde = .Columns(1).Find(What:="Nr,")
'Anweisungen gelöscht, da Ergebnis nicht weiter verwendet wird
.Range(rngStart.Offset(2, 0), rngEnde.Offset(-3, 0)).Copy wsZiel.Range("A5")
.Range(rngStart.Offset(2, 1), rngEnde.Offset(-3, 2)).Copy wsZiel.Range("E5")
.Range("D4").Copy wsZiel.Range("d5")
Range("d16").Select
Dim Zeile As Double
Const Spalte As Integer = 1
Zeile = 16
Do While .Cells(Zeile, Spalte)  ""
With .Cells(Zeile, 4)
.Formula = "=TRIM(RC[-2])"
.Value = .Value
.Offset(0, -2).Range("A1").Value = .Value
.Clear
End With
Zeile = Zeile + 1
Loop
.Range(TransStart.Offset(3, 0), TransEnde.Offset(-2, 1)).Copy
'Transponiere Bereich ab Transstart plus 3 Zeilen bis Transende minus 2 Zeilen plus 1 Spalte
.Cells(Zeile, 4).Offset(1, 2).Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:= _
xlNone, _
SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Set rngStart = .Cells.Find(What:="Nr,", After:=.Range("A1"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
For lngSpa = 9 To 29 ' I is AC
varSuch = ""
Select Case lngSpa
Case 9: varSuch = "Tabelle_01 I weiss 30-36"
Case 10: varSuch = "Tabelle_01 I weiss 25-30"
Case 11: varSuch = "Tabelle_01 I weiss 21-25"
Case 12: varSuch = "Tabelle_01 I weiss 16-21"
Case 13: varSuch = "Tabelle_01 I weiss 14+"
Case 14: varSuch = "Tabelle_01 II weiss 16-25"
Case 15: varSuch = "Tabelle_01 II weiss 14+"
Case 16: varSuch = "Tabelle_01 I vio 16-26"
Case 17: varSuch = "Tabelle_01 II ws/Vio 30-36"
Case 18: varSuch = "Tabelle_01 II ws/Vio 25-30"
Case 19: varSuch = "Tabelle_01 II ws/Vio 21-25"
Case 20: varSuch = "Tabelle_01 II ws/Vio 16-21"
Case 21: varSuch = "Tabelle_01 II ws/Vio 14+"
Case 22: varSuch = "Tabelle_01 I K?pfe"
Case 23: varSuch = "Tabelle_01 II K?pfe"
Case 24: varSuch = "Tabelle_01 Rest"
Case 25: varSuch = "Tabelle_10 I 12 16"
Case 26: varSuch = "Tabelle_10 I 8 12"
Case 27: varSuch = "Tabelle_10 II 12+"
Case 28: varSuch = "Tabelle_10 II 8+"
Case 29: varSuch = "nicht zugeordnet"
End Select
If varSuch  "" Then
Set rngZelle = .Cells.Find(What:=varSuch, After:=rngStart.Offset(1, 5), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, _
MatchCase:=True)
If Not rngZelle Is Nothing Then
With rngZelle.Offset(3, 0)
ws.Range(ws.Cells(.Row, .Column), ws.Cells(325, .Column)).Copy _
wsZiel.Cells(5, lngSpa)
End With
End If
End If
Next
End With
'rngStart.Offset(1, 5).Select
End Sub

Anzeige
AW: Spaltenüberschriften suchen und Spalten kopieren
18.03.2019 19:17:16
Bauer
Hallo Franz
die laufen beide super.
Vielen Dank. Auch für deinen Tipp ich werde ihn ausprobieren.
Ein kleiner Fehler ist noch drin im ersten Makro
For lngSpa = 9 To 29 ' I is AC
varSuch = ""
rngStart.Offset(1, 5).Select
muss es rngStart.Offset(1, 4).Select heißen sonst wird die erste Spalte falsch kopiert.
Nur zur Vollständigkeit für weitere Leser und Kopierer der Lösung nicht als Kritik gedacht.
Ich bin ausgesprochen froh das du diese Lösungen für mich geschrieben hast und ich lerne viel dadurch. Ich finde es super das man mit F8 das Makro schrittweise laufen lassen kann und sehen kann wo es hakt. Das ist für solche Laien wie mich sehr hilfreich.
Nochmals vielen Dank für die Lösungen.
Eine Frage habe ich doch noch. Ich habe am Anfang des Makros Bereiche zwischen 2 Texten markieren lassen und kopiert. Wie kann ich den Bereich übernehmen für die Spalten mit den Sortierungen?
Viele Grüße Bauer
Anzeige
AW: Spaltenüberschriften suchen und Spalten kopieren
21.03.2019 18:02:55
fcs
Hallo Bauer,
die Vorgehensweise zur Ermittlung des Zellbereichs mit den Gesuchten Daten ist abhängigvon der Struktur in der CSV. Leider kann ich deine Datei von der Webseite nicht herunterladen (Firmen-Sicherheitsmassnahmen).
Grundsätzlich könnte man nach den möglicherweise vorhandenen Texten in einer Schleife suchen und be den vorhandenen die Zellen mit der niedrigsten und höchsten Zeilennummer ermitteln. Zusätzlich dan noch für alle Treffer die 1. und letzte Spaltennummer (davon dann auch wieder min. und Max.)
Damit hast dann die linke obere und die rechte unter Zelle des Bereichs mit den Daten und kannst diesen dann entsprechend weiter verarbeiten.
Gruß
Franz
Anzeige
AW: Spaltenüberschriften suchen und Spalten kopieren
17.03.2019 17:48:54
Alexandra
Hi Bauer,
lade doch mal deine Beispieldatei hoch, damit man das besser nachvollziehen kann!
LG
Alexandra
AW: Spaltenüberschriften suchen und Spalten kopieren
17.03.2019 18:16:19
Bauer
Hallo Alexandra
leider bekomme ich eine Fehlermeldung das ich csv Dateien nicht hochladen kann. Gibt es da einen Trick?
Danke.
LG
Bauer
AW: Spaltenüberschriften suchen und Spalten kopieren
17.03.2019 18:17:50
Hajo_Zi
Zip
es sind doch mehrere Dateien. Der Code wird ja nicht in der CSV Datei sein.

Beiträge von Werner, Luc, robert, J.O.Maximo und folgende lese ich nicht.
Die Beiträge werden auch ignoriert, es erfolgt keine Antwort.
AW: Spaltenüberschriften suchen und Spalten kopieren
17.03.2019 18:18:35
Alexandra
Hi Bauer,
du kannst es auf Dropbox oder Onedrive hochladen und den Link hier rein!
LG
Alexandra
Anzeige
AW: Spaltenüberschriften suchen und Spalten kopieren
17.03.2019 18:30:46
Bauer
Hallo Alexandra
Hier der Link zur csv Quelldatei. Die Zieldatei lade ich in Auszügen (sonst 50MB) sobald ich sie gekürzt habe auch noch hoch.
Danke.
https://1drv.ms/u/s!AhMwWSHT1e8PiBMA-HUdzspRzMgR
Gruß Bauer
AW: Spaltenüberschriften suchen und Spalten kopieren
17.03.2019 18:46:42
Bauer
Hallo Zusammen
ich habe das Problem das in der Quelldatei die Anzahl der Sortierungen #1,#2.. variiert und sich dadurch auch der beginn der Daten nach unten oder oben verschiebt. Deswegen habe ich auch den Weg mit der Transformierung der Sortierungen zu den Spaltenüberschriften gewählt da die #1 nicht immer die gleiche Sortierung ist.
Ich hoffe es ist verständlich was ich gemacht habe und wo mein Problem im Moment ist.
Danke
Gruß Bauer
Anzeige

305 Forumthreads zu ähnlichen Themen

In Spalte nach Anzahl eines Begriffs suchen?
Lauren

Hall Leute!
ich will nach einem Begriff, in meinem Fall nach "SUMs" in der Spalte C suchen und wissen wie oft es in der Spalte vorkommt.
Bei Berechnungen funktioniert es mit ZÄHLENWENN ohne Probleme aber wie erhalte ich die "absolute" Zahl?
Vielen Dank für Eure Hilfe!
Grüße
...
19.08.2008 11:08:23
Thread-ID: 1002846
5 Beiträge
Anzeige
Häufigkeit einer Uhrzeit aus einer Spalte
wolfgang

Hallo Leute
Ich habe eine Spalte mit einer menge Uhrzeiten und möchte die Häufigkeit einer Uhrzeit ( wie oft ist eine eintrag vorhanden)zum Beispiel zwischen 08:00 und 17:00!! Ich weiß das für euch sicher ein leichtes ist jemanden wie mir zu helfen!
Schon jetzt besten Dank für eure Mühe...
02.09.2008 15:11:51
Thread-ID: 1006816
2 Beiträge
von Datum bis Datum suchen und Werte in die Spalte
Datum

Hallo liebe Excel-Könner,
ich habe folgendes Problem und finde keine Lösung.
Ich habe in Spalte A von 2006 bis heute Datum stehen, über eine UserForm möche ich in zwei TextBoxen von bis Datum eintragen und in Spalte B in diesem Bereich den WertX.
Ich hoffe Ihr könnt mir helfen!
...
07.09.2008 09:31:20
Thread-ID: 1007931
8 Beiträge
Anzeige
Berechnen von Werten in einer Spalte
Werten

Folgendes Problem:
In der Spalte A möchte ich wissen, wieviel unterschiedliche Werte es gibt.
Wer kann mir helfen.
Danke
Alex
05.10.2008 12:52:00
Thread-ID: 1014231
5 Beiträge
Filtern, gefilterte Daten benutzen, Suchen und Aus
Merle


Hallo alle zusammen,
ich habe ein mittelschweres Problem. Und zwar habe ich hier ein Beispiel:
https://www.herber.de/bbs/user/55986.xls
In 'Tabelle1' sind ganz viele verschiedene Waren (C17:57) hinterlegt. Ich möchte nun, wenn ich eine dieser Waren rausfilter z.B H025, dass da...
13.10.2008 15:48:00
Thread-ID: 1016087
3 Beiträge
Gleiche Eintäge in einer Spalte nacheinander finde
Malcolm_p

Hallo zusammen!
Wenn ich einen bestimmten Eintrag - per VBA - in einer Spalte finden möchte verwende ich der Regel den folgenden Code:
Dim NameSP As Range
Set NameSP = Sheets("Konten").Rows(1).Find( _
What:=Textbox1, _
Lookat:=xlWhole, _
LookIn:=xlValues)
Dim Erfdat...
15.10.2008 23:08:59
Thread-ID: 1016705
5 Beiträge
Suchen und Ersetzen schnelleres Makro
Susi

Hallo liebe Excel-Freunde,
ich habe folgendes kleines Makro.
Sub Suchen_Ersetzen() out = "15200" 'zu ersetzender String in = "43900" 'einzufügender String For Each cell In Selection If cell.HasFormula = True Then cell.Formula = Application.WorksheetFunction.Substitute(cell.Formula, ou...
20.10.2008 12:19:00
Thread-ID: 1017624
17 Beiträge
Doppelte Einträge in einer Spalte farbig markieren
Robert

Hallo,
ich hab eine Tabelle mit riesigem Datenbestand. Mein Problem ist nun, dass doppelte Eintrage, die in einer Spalte vorkommen, farbig markiert werden sollten - und das gleiche bei jeder weiteren Spalte mit Inhalt.
Sollten in einer Spalte doppelte Einträge vorhanden sein, müsste die...
27.10.2008 19:09:00
Thread-ID: 1019713
11 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
4
8
1
7
5
4
2
4
16
10
2
3
6
8
4
2
3
4
2
15
10
5
1
5
3