Hallo Leute
Vorab mal, meine VBA kenntnisse halten sich sehr in grenzen
Um euch kurz mein Ziel zu schildern.
Ich bekomme eine Excel Mappe, welche Daten beinhaltet
Es gibt diverse Positionen die wichtigste liegt in der Spalte „W“, an hand von diser Zeile sollte dann die neue Excel Mappe erstellt werden, wichtig sind ebenfalls die Positonen in der Spalte „T“, diese sollen summiert werden und jeweils von der Zeile der jeweiligen Person zugeordnet werden.
Mein plan war es die Jeweiligen Nummern zu überprüfen & anschliessend bei einer existierten Excel mappe dies unten anfügen und falls keine erstellt ist eine neue anlegen. Die Resultierung aus der Spalte „T“ sollte in der Spalte „BX“ erfolgen.
Folgendes Funktioniert noch nicht:
Ich möchte das gesamte Sheet überprüfen auf die Werte in Spalte „W“, mit dieser soll im aktuellen Pfad eine neue Mappe erstellt werden falls noch keine Exisitert.
Wenn die Zeile etwas beinhaltet soll die gesamte Reihe Selektiert werden und in die Mappe mit dem ensprechenden Namen kopiert werden (bei letzter Zeile anfügen)
Hier Der Code:
"
Sub Auswertung()
Dim GetName As String
Dim i As Long
Dim HowLongIsIt As Long
Dim WordSelect As String
Dim WordCompair As String
Dim WordCompairCounter As Long
Dim HowLongIsItCompair As Long
Tabelle1.UsedRange.Column.Count
HowLongIsIt = ActiveSheet.UsedRange. ’ Vllt. noch anpassen bei Row
MsgBox („Hallo:“ & HowLongIsIt)
WordCompairCounter = 1
WordCompair = Tabelle2.Cells(WordCompairCounter, 2).Value
For i = 1 To HowLongIsIt
WordSelect = Tabelle1.Cells(i, 23).Value
If WordSelect = WordCompair Then
'Ganzereihe in NeusTextdokument Kopieren Cursor auf nächste Zeile Setzten oder via HowLong is it beim nächsten mal einfügen
Else
HowLongIsItCompair = Tabelle2.UsedRange.Rows.Count
For WordCompairCount = 1 To HwoLongIsItCompair
WordCompair = Tabelle2.Cells(WordCompaorCounter, 2).Value
If WordSelect = WordCompair Then
'Ganzereihe in NeusTextdokument Kopieren Cursor auf nächste Zeile Setzten oder via HowLong is it beim nächsten mal einfügen
Tabelle1.Rows(„i:i“).Select
Selection.Copy
’ Woorkbook Exist?
Else
With Application.FileSearch
.LookIn = ThisWoorkbook.Path
.Filename = WordSelect & „.xls“
If .Execute > 0 Then
Application.Workbooks.Open (ThisWorbook.Path & „“ & WordSelect & „.xls“)
’ HowLongisit +1 *Paste*
MsgBox („kein File wurde erstellt“)
Selection.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
Else
Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & „“ & WordSelect & „.xls“
Selection.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
MsgBox („Ein neues File wurde erstellt“)
End If
End With
End If
Next WordCompairCount
End If
Next i
End Sub
"
Bin für jeden Lösungsvorschlag extrem dankbar
