ich brauche wieder mal eure Hilfe.
Ich benötige ein Makro welches bei jedem öffnen einer Datei ausgeführt wird.
Das Makro soll in mehreren Dateien mit unterschiedlichen Namen eingesetzt werden.
Dieses Makro soll Daten aus einer anderen Datei (Basisdatei) kopieren. Die Basisdatei ist direkt unter C gespeichert. (C:\Basisdatei\LKW..xlsm)
Aus dieser Datei soll in jedem Fall der Bereich A7 bis E350 und eine komplette Spalte mit allen Formaten und Spaltenbreite in die geöffnete Datei kopiert werden. Der kopierte Bereich A7 bis E350 soll ab A7 eingefügt werden und die kopierte Spalte in G1
Der Tabellenblattname und die zu kopierende Spalte sollen aus der geöffneten Datei in der Tabelle "Optionen" ausgelesen werden. Der Tabellenblattname steht in A4 und die Spalte steht direkt als Buchstabe in A2.
Die Daten dürfen aber nicht in die Tabelle "Optionen" kopiert werden, sondern in eine andere Tabelle! Die hat aber in jeder Datei einen anderen Namen und ist schreibgeschützt!
Außerdem soll aus der Basisdatei im Tabellenblatt "Übersicht" der Bereich A6 bis A30 in die geöffnete Datei in die Tabelle "Optionen" in den Bereich A6 bis A30 kopiert werden. Die Spalte A ist ausgeblendet.
Ich habe vorher schon einmal eine Lösung zu einem ähnlichen Problem erhalten. In dieser Version wird der Tabellenname der zu kopierenden Datei per Combox ausgewählt. Leider bin ich nicht in der Lage die Codes so umzugestalten, dass sie den jetzigen Anforderungen entsprechen.
Hier die Codes:
Private Sub ComboBox1_Change()
Dim objWorkbook As Workbook
If ComboBox1.ListIndex > -1 Then
Application.ScreenUpdating = False
Range("A1").Value = Range("A2").Value
Set objWorkbook = Workbooks.Open(Filename:=MASTER_FILE, ReadOnly:=True)
With objWorkbook.Worksheets(ComboBox1.Text)
Union(.Columns("A:E"), .Columns(Range("A1").Value)).Copy Destination:=Range("D1")
End With
objWorkbook.Worksheets("Optionen").Range("A5:A30").Copy Destination:=Range("A5")
objWorkbook.Close SaveChanges:=False
Set objWorkbook = Nothing
Application.Goto Range("D3")
ComboBox1.ListIndex = -1
Application.ScreenUpdating = True
End If
End Sub
und im Modul:Option Explicit
Public Const MASTER_FILE As String = "C:\Stammdatei\Stammdatei LKW.xlsm" 'Anpassen !!!!!!!!!!!
Public Sub UpdateCombobox()
Dim objConnection As Object, objCatalog As Object, objTables As Object
Dim strConnection As String, strTableName As String
Set objConnection = CreateObject("ADODB.Connection")
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & MASTER_FILE & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;IMEX=0"""
Call objConnection.Open(strConnection)
Set objCatalog = CreateObject("ADOX.Catalog")
Set objCatalog.ActiveConnection = objConnection
With Tabelle1.ComboBox1
Call .Clear
For Each objTables In objCatalog.Tables
strTableName = objTables.Name
If InStr(1, strTableName, "Print_Area") = 0 Then
strTableName = Replace(strTableName, "'", "")
strTableName = Replace(strTableName, "$", "")
strTableName = Replace(strTableName, "#", ".")
If strTableName "Button" Then Call .AddItem(strTableName)
End If
Next
End With
Set objCatalog = Nothing
objConnection.Close
Set objConnection = Nothing
End Sub
Vielleicht kann mir jemand diese Codes umschreiben!Gruß manega