Office: (Office 365) VBA Makro einfügen CSV, verarbeiten und abspeichern

Hallo zusammen,

erstmal vorab meine VBA Kenntnisse sind sehr rudimentär.

Aufgabenstellung in Kurz:

Ich hab 2 Dateien, eine Hauptdatei (IDXXXX_8x8_GV-contrast.xlsm) und eine CSV die folgendermaßen Beispielhaft benannt ist ID06850.csv (die Nummern ändern sich, Name bleibt immer gleich lang).

Ich hab nun die Herausforderung ein Makro zu schreiben, dass sich in einer Excel Datei befindet in der 2 Arbeitsblätter sind (grey value mesh 8x8, Graph).

In diese Hauptdatei möchte ich aus einer CSV Datei meiner Wahl (anfangend aus dem selben Ordner in dem diese Hauptdatei liegt), einen Teil (immer Zeile 2-65 und Spalte A-D, Zeile 1 ist Überschrift die brauch ich nicht) daraus importierten.

Diese Daten sollen in der Haupdatei im Blatt "grey value mesh 8x8" in Zeile 2-65 und Spalte B-E einfgefügt werden.

!Dieser Teil ist teilweise geschafft. Das Makro startet bei der Dateiauswahl nur nicht im selben Ordner im dem die Hauptdatei liegt!

Um folgendes möchte ich das Makro noch erweitern:
1. Das was oben fehlt, das Makro soll beim "Öffnen Fenster" da Anfangen wo die Hauptdatei liegt.
2. Aus dem Namen der gewählten CSV Datei im Blatt "Graph" in Feld H12 die Nummer der ID eintragen (nur die Nummer ohne ID davor und .csv dahinter)
3. In dem Ordner in dem sich die Haupdatei befindet, soll dann die Datei als ID06850_8x8_GV-contrast.xlsm abgespeichert werden.
4. Die Hauptdatei (IDXXXX_8x8_GV-contrast.xlsm) soll weiter offen bleiben und die .csv mit der gerade gearbeitet wurde geschlossen werden.

Folgendermaßen schaut das Makro momentan aus:

Sub importCSV()
'
' importCSV Makro
'
' Tastenkombination: Strg+ä
'
strOpenFile = Application.GetOpenFilename(, , "Please choose CSV:")
Workbooks.OpenText Filename:= _
strOpenFile, Origin:=65001, StartRow _
:=2, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
Range("A1:D64").Select
Selection.Copy
Windows("IDXXXX_8x8_GV-contrast.xlsm").Activate
Range("B2").Select
ActiveSheet.Paste
End Sub


Das Makro wurde aufgenommen und da hab ich beim import schon angeklickt das er ab Zeile 2 anfangen soll und Zeile 1 garnicht erst mitnimmt.

Wäre für jede Hilfe dankbar, da ich hierzu nichts praktikables gefunden hab bis jetzt.

Gruß Mark

 

Moin Mark,

schau Dir zu diesem Thema mal diesen Link an. Da wird eine flexible Methode zum Öffnen bestimmter Ordner beschrieben.
VBA - Dialogfenster "Datei öffnen" - Automate Excel

Viel Spaß!

 

Hi vielen Dank für den Tipp.

Leider steht da "nur" wie ich aus einem bestimmten Ordner die Datei laden kann, nicht aber wie er den Ordner im Fenster schon anwählt in dem die Hauptdatei liegt. Der Ordner in den ich die Hauptdatei immer reinkopiere ändert sich vom Namen immer (laufende Auftragsnummer usw... ).

Hast du da n Tipp?

Gruß Mark

 

Hallo,

folgendes Makro sollte dafür Abhilfe schaffen:

Code:

Option Explicit

Sub importCSV()
'
' importCSV Makro
'
' Tastenkombination: Strg+ä
'
   Dim strOpenFile As String
  
   With Application.FileDialog(fileDialogType:=msoFileDialogFilePicker)
     .AllowMultiSelect = False
     .InitialView = msoFileDialogViewDetails
     .InitialFileName = ActiveWorkbook.Path
     .Title = "Please choose CSV:"
     With .Filters
       .Clear
       .Add "CSV-Dateien", "*.CSV", 1
     End With
     If .Show = -1 Then
       strOpenFile = .SelectedItems(1)
     End If
   End With
  
'   strOpenFile = Application.GetOpenFilename(, , "Please choose CSV:")
  
   Workbooks.OpenText Filename:=strOpenFile, Origin:=65001, StartRow:=2, _
     DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
     ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False, _
     FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
  
   Range("A1:D64").Copy Destination:=Worksheets("Zielblatt").Range("B2")
  
'   Range("A1:D64").Select
'   Selection.Copy
'   Windows("IDXXXX_8x8_GV-contrast.xlsm").Activate
'   Range("B2").Select
'   ActiveSheet.Paste

End Sub

In der letzten Codezeile musst du statt "Zielblatt" den Namen des Arbeitsblattes einsetzen, in dem die Zielzelle B2 liegt.

 

Hallo,

die letzte Codezeile muss natürlich heißen:
Range("A1:D64").Copy Destination:=ThisWorkbook.Worksheets("Zielblatt").Range("B2")
wobei wiederum "Zielblatt" zu ersetzen ist mit dem richtigen Arbeitsblattnamen des Kopierzieles. Dabei muss sich "Zielblatt" in derselben Arbeitsmappe befinden, in der sich auch das Makro befindet.

 

Super das funktioniert ja mega :D. Danke. Jetzt muss ich mich "nur" noch um das Speichern und schließen kümmern.

 

Ok für den Namen hab ich folgenden Lösungsansatz:
Dim blattname As String
Application.Volatile
blattname = ActiveSheet.Name
Sheets("ThisWorkbook.Worksheets("Graph").Range("H12")").Range("A1")").Value = blattname

Bis blattname = ActiveSheet.Name is alles tutti nur will er mir es nicht in mein anderes Workbook schreiben mit folgender Fehlermeldung: Fehler beim kompilieren erwartet Listentrennzeichen oder).

Screenshot:



Hat wer nen tipp wie ich die Variable blattname in meinem Hauptdokument im Blatt Graph in Zelle H12 angezeigt bekomme?

Danke schonmal

Mark

 

Hallo,

was willst du mit dieser Zuweisungszeile erreichen? Außer dass du den Namen des aktiven Arbeitsblattes an irgendwelche Zellen des Arbeitsblattes "Graph" zuweisen möchtest, verstehe ich überhaupt nichts - und VBA ist natürlich damit total überfordert.
Zu sehen sind die beiden Zellen A1 und H12 - was soll mit diesen geschehen?

 

Hallo,

ThisWorkbook.Worksheets("Graph").Range("H12").Value = blattname

 

Also ich möchte erreichten das er mir den Namen des aktiven Arbeitsblattes in die Hauptdatei IDXXXX_8x8_GV-contrast.xlsm im selben Ordner (die is ja schon offen) auf auf das Arbeitsblatt Graph Zelle H12 schreibt. Das .Range("A1") war n copy paste fehler den ich nicht gesehen habe.

 

Wow das funktioniert ja super. Gibt es eine möglichkeit dann automatisch am Schluss die Datei mit dem blattnamen_8x8_GV-contrast.xlsm extra zu speichern. Ich mein ohne das er die Hauptdatei die offen ist abspeichert?

Anders ausgedrückt, er erstellt danach aus der Hauptdatei im Hintergrund die Datei (Beispiel) ID06850_8x8_GV-contrast.xls und die Hauptdatei wird nicht gespeichert.

Geht das? Wenn ja wie?

 

Hallo,

mit der folgenden Anweisung wird die Excel-Datei mit dem Makro und den beiden Arbeitsblättern "grey value mesh 8x8" und "Graph" als Kopie unter dem neuen Namen Blattname & "_8x8_GV-contrast.xlsm" gespeichert, wobei der Inhalt der Variablen Blattname vom CSV-Dateinamen herrührt.
Wenn die Variable Blattname den Inhalt "ID06850" hat, wird eine Kopie der Excel-Datei mit Dateiname "ID06850_8x8_GV-contrast.xlsm" im ebenfalls anzugebenden Pfad gespeichert:

ThisWorkbook.SaveCopyAs Filename:="Pfad\" & Blattname & "_8x8_GV-contrast.xlsm"

 

Hi, super danke das du mir da grad so viel hilfst. Jetzt hab ich das Problem das der Pfad praktisch immer der sein muss wo die Hauptdatei drin liegt. Ich habs versucht mit ActiveWorkbook.Path

ThisWorkbook.SaveCopyAs Filename:=ActiveWorkbook.Path & blattname & "_8x8_GV-contrast.xlsm"

Nur des interessiert ihn nicht. (Hab die Zeile mal auskommentiert, war noch aus nem versuch obs mit "" geht, Überraschung tuts nicht.)

Hier mal der ganze code:

Sub importCSV()
'
' importCSV Makro
'
' Tastenkombination: Strg+ä
'

'Datei öffnen

Dim strOpenFile As String

With Application.FileDialog(fileDialogType:=msoFileDialogFilePicker)
.AllowMultiSelect = False
.InitialView = msoFileDialogViewDetails
.InitialFileName = ActiveWorkbook.Path
.Title = "Please choose CSV:"
With .Filters
.Clear
.Add "CSV-Dateien", "*.CSV", 1
End With
If .Show = -1 Then
strOpenFile = .SelectedItems(1)
End If
End With

'CSV verarbeiten

Workbooks.OpenText Filename:=strOpenFile, Origin:=65001, StartRow:=2, _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True

Range("A1:D64").Copy Destination:=ThisWorkbook.Worksheets("grey value mesh 8x8").Range("B2")

'Name aus CSV holen und einfügen
Dim blattname As String
Application.Volatile
blattname = ActiveSheet.Name
ThisWorkbook.Worksheets("Graph").Range("H12").Value = blattname

'Sichern der Hauptdatei mit blattname

'ThisWorkbook.SaveCopyAs Filename:="ActiveWorkbook.Path\" & blattname & "_8x8_GV-contrast.xlsm"

'Schließen der CSV

ActiveWorkbook.Close SaveChanges = False

'Aktivieren der Haupdatei

Windows("IDXXXX_8x8_GV-contrast.xlsm").Activate

End Sub

 

Hallo,

das kann so nicht funktionieren. Falls du meinen Hinweis genau gelesen hast, steht dort
ThisWorkbook.SaveCopyAs Filename:="Pfad\" & Blattname & "_8x8_GV-contrast.xlsm"
somit muss die Anweisung lauten wie folgt:
ThisWorkbook.SaveCopyAs Filename:=ActiveWorkbook.Path & "\" & blattname & "_8x8_GV-contrast.xlsm"

 

ok ich hatte dahinter auch mal das\ stehen aber warum muss das \ mit &"\" angehängt werden?

Vielen Dank auf jedenfall für deine großartige Hilfe!