Anzeige
Archiv - Navigation
1456to1460
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Spalte und Blattname aus anderer Datei entnehmen

Spalte und Blattname aus anderer Datei entnehmen
08.11.2015 17:59:38
manega
Hallo Experten,
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalte und Blattname aus anderer Datei entnehmen
12.11.2015 01:04:27
fcs
Hallo Manega,
hier ein ungetesteter Vorschlag.
Gruß
Franz
'Code unter DieseArbeitsmappe
Option Explicit
Private Const MASTER_FILE As String = "C:\Stammdatei\Stammdatei LKW.xlsm" 'Anpassen !!!!!!!!!!!
Private Sub Workbook_Open()
Dim wkbBasis As Workbook, wkbThis As Workbook
Dim wksBasis As Worksheet, wksThis As Worksheet, wksOptionen As Worksheet
Dim strBlatt_Q As String, strSpalte_Q As String
Dim StatusCalc As Long
Set wkbThis = Me
Set wksOptionen = wkbThis.Worksheets("Optionen")
strBlatt_Q = wksOptionen.Range("A4")  'Tabellenblatt in Basis-Datei
strSpalte_Q = wksOptionen.Range("A2") 'Spalte in Basis-Datei
'Zieltabelle in geöffneter Datei
Set wksThis = wkbThis(3) 'Index-nummer, wenn in allen Dateien identisch, _
sonst mit individuellem Blattnamen in jeder Datei arbeiten
With Application
.ScreenUpdating = False
.EnableEvents = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set wkbBasis = Workbooks.Open(Filename:=MASTER_FILE, ReadOnly:=True)
Set wksBasis = wkbBasis.Worksheets(strBlatt_Q)
wksThis.Unprotect
wksBasis.Range("A7:E350").Copy wksThis.Range("A7:E350")
wksBasis.Range(strSpalte_Q & ":" & strSpalte_Q).Copy wksThis.Range("G:G")
wksThis.Protect
Set wksBasis = wkbBasis.Worksheets("Übersicht")
wksBasis.Range("A6:A30").Copy wksOptionen.Range("A6:A30")
wkbBasis.Close savechanges:=False
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = StatusCalc
End With
End Sub

Anzeige

322 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige