|
Hallo zusammen
ich habe ein Problem mit Spalten aus einer anderen Excel-Datei kopieren.
1. Aus einem Excel-Sheet wird das Makro gestartet.
2. Aus einem anderen Excel-Sheet (Auswahl der Datei sollte selbst vorgenommen werden können, jedoch mit Verzeichnisvorgabe).
3. Andere Datei, aus der einzelnen Spalten kopiert werden sollen, wird geöffnet
4. In Zelle 1 wird einerseits nach dem Text "Anlage" und nach dem Text "Preis pro kwh" gesucht.
5. Sobald diese Texte gefunden wurden, sollen die entsprechenden Spalten mit Überprüfung der Spaltenlänge
kopiert werden.
6. Dieses Excel-File schliessen und die einzelnen Spaltendaten in das Quell-Excel-File schreiben.
Ich habe unten den "Codeschnipsel", jedoch gibt es noch einige Probleme und ich komme nicht weiter:
Sub CommandButton2_Click()
Dim WbDatei1 As Workbook
Dim WbDatei2 As Workbook
Dim strFilter As String
Dim Wert1 As Variant
Dim Wert2 As Variant
Dim i As Integer
Set WbDatei2 = ThisWorkbook
'** Dateifilter definieren
strFilter = "Excel-Dateien(*.xls*), *.xls*"
'** Laufwerk und Pfad definieren, welcher geöffnet werden soll
ChDir "\\XXXXX\" ' muss noch angegeben werden
'** Dateifilter definieren
strFilter = "Excel-Dateien(*.xls*), *.xls*"
'** Den im Dialogfeld gewählten Namen auslesen
strFileName = Application.GetOpenFilename(strFilter)
'** Prüfen, ob eine gültige Datei ausgewählt wurde
If strFileName = False Then Exit Sub
'** Gewählte Datei öffnen
Set ActiveWorkbooks = Workbooks.Open(strFileName)
'** Hinweis ausgeben
MsgBox "Die Datei '" & ActiveWorkbook.name & "' wurde geöffnet.", vbInformation, "Hinweis"
With Worksheets("Format")
For i = 1 To .Columns.Count
If Cells(1, i) = "Anlage" Then
Wert1 = Range(Cells(2, i), Cells(1000, i))
End If
If Cells(1, i) = "Preis pro kwh" Then
Wert2 = Range(Cells(2, i), Cells(1000, i))
End If
Next i
End With
'Wert1 = Cells(2, "A") 'Daten auslesen
ActiveWorkbooks.Close SaveChanges:=False 'schliesst File ohne zu speichern
Set WbDatei2 = ThisWorkbook
With ThisWorkbook.Worksheets("Tabelle1")
For i = 1 To .Columns.Count
If Cells(1, i) = "Anlage" Then
Range(Cells(2, i), Cells(1000, i)) = Wert1
End If
If Cells(1, i) = "Preis pro Kwh" Then
Range(Cells(2, i), Cells(1000, i)) = Wert2
End If
Next i
End With
Application.DisplayAlerts = True
End Sub
Ich danke Euch schon mal für eure Hilfe.
Gruss
Andi |