Verteilen von Daten Per Makro von Cysu11

Hallo Zusammen
Ich habe vor ca 2 Wochen bereits in diesem Forum geschrieben und von einer Userin namens Cysu11 sehr viel Unterstützung erhalten. In der Zwischenzeit ist mein Tool noch ausgebaut worden. Aktuell habe ich jedoch ein Problem:
https://www.herber.de/bbs/user/129266.xlsm
Die Userin hat mir ein Makro erstellt um Daten auf entsprechende Tabellen zu verteilen. Jetzt möchte ich das noch auf ein weiteres Blatt ("Belag") anwenden. Mein Problem ist das der Vorgang nicht genau gleich ist und ich deshalb das Makro nur bedingt anpassen kann.
Mein Ziel ist folgendes:
Im Blatt "Import CSV" werden Daten eingefügt welche verteilt werden bzw. durch das Makro teilweise schon erfolgt. Jetzt möchte ich die gleiche Daten im Blatt "Belag" verteilt haben wie im Blatt " Platten".
Es soll jetzt aber für das Blatt "Belag" nicht mehr die Spalte O beachtet werden sondern die Gelb markierten Spalten M und N. Es soll sobald in der Spalte M (ab Zeile 8) etwas steht die Daten im Blatt "Belag" eintragen. Dabei sollt e folgendes beachtet werden:
Steht in der Spalte M und N das gleiche, soll es zu bei den Spalten D und E jeweils 10 dazu rechnen und die Anzahl Spalte C mal 2 rechnen.
Sind die Spalten M und N verschieden, sollen zwei Zeilen erstellt werden.
Erste Zeile Zeile M jedoch nicht mal 2 (Aufmass soll bestehen bleiben). Anschliessend das gleich mit der ersten Zeile N. Und wieder von vorne bis alle Zeilen überprüft sind.
Das ganze sollte sofern möglich in den bestehenden Code eingebaut sein.
Ist das möglich und kann mir das jemand machen.
Besten Dank im voraus.
Lg Dani

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Alexandra
Folgend mein Code ohne Änderungen:

Sub ImportCSV()
' ImportCSV Makro
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\dg\Desktop\WS Test Drenush\Knecht Katalog.csv", Destination:= _
Range("$A$1"))
.CommandType = 0
.Name = "Knecht Katalog"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Start").Select
End Sub

Und hier habe ich den Pfad geändert.

Sub ImportCSV()
' ImportCSV Makro
With ActiveSheet.QueryTables.Add(Connection:= _
"Thisworkbook.Path", Destination:= _
Range("$A$1"))
.CommandType = 0
.Name = "Knecht Katalog"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Start").Select
End Sub

Funktioniert leider nicht. Ich vermute ich muss den Namen "Knecht Katalog " noch ersetzten. (Mein Ziel ist es das ich beim Ausführen des Makros im Ordner die gewünschte Datei auswählen kann ( Diese kann unterschiedlich benannt sein)
Wie kann ich das machen?
Lg Dani

Sub ImportCSV() Dim Startdirectory As String Dim strDatei As String Startdirectory = ThisWorkbook.Path ChDrive Left(Startdirectory, 1) ChDir Startdirectory Application.ScreenUpdating = False strDatei = Application.GetOpenFilename("Excel-Dateien(*.csv*), *.csv*", MultiSelect:=False) If strDatei = "" Then Exit Sub With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & Startdirectory & strDatei, Destination:= _ Range("$A$1")) .CommandType = 0 .Name = "Knecht Katalog" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 65001 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Sheets("Start").Select End Sub

Sub ExportCSV() strdatei = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) strpath = "C:\Testordner\" Sheets("Export CSV").Activate ActiveSheet.Copy ActiveSheet.SaveAs Filename:=strpath & strdatei, FileFormat:=xlCSV, Local:=True ActiveWorkbook.Close SaveChanges:=False Sheets("Start").Select End Sub

Sub ExportCSV() strdatei = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) strpath = "C:\Users\dg\Desktop\WS Test Drenush" Sheets("Export CSV").Activate ActiveSheet.Copy ActiveSheet.SaveAs Filename:=strdatei, FileFormat:=xlCSV, Local:=False ActiveWorkbook.Close SaveChanges:=False Sheets("Start").Select End Sub

Beliebteste Forumthreads (12 Monate)

Verteilen von Daten Per Makro von Cysu11

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread