von wellkisch » Di, 08.03.2011 12:22
Ich habe mir nach langen Probieren ein Makro in Excel erstellt, welches Zellwerte aus einzelnen Dateien in eine Übersichtsdatei als Verknüpfung einfügt. Dazu wird der Dateiname der ersten Datei abgefragt und dann automatisch Zelle für Zelle in die Übersichtsdatei übernommen.
Dieses Makro ist für mich sehr wichtig und hält mich davon ab endlich auf Open/Libreoffice umzusteigen. Die Versuche meinerseits das Makro in Open/Libreoffice umzuwandeln enden mit etlichen Fehlermeldungen.
Wo liegt mein Problem- kann mir jemand helfen?
hier die gekürzte Fassung:
Code: Alles auswählen
Sub a_Tabellen_einbinden()
'
' Makro2 Makro
' Makro am 10.10.2001 von Wellkisch aufgezeichnet
'
1
'
'Fügt Daten der Datei "Dateiname" in Datei Übersicht.xls ein
Dim dateiname As String
'Dim datei As String
'Aufruf des Dateidialoges
dateiname = Application.GetOpenFilename
'wenn Abbrechen oder ESC gedückt wurde
If dateiname = "Falsch" Then
'MsgBox "Sie haben keine Datei gewählt!"
GoTo 2
' Sonst wird die gewählte Datei angezeigt
Else
'MsgBox "Sie haben die Datei " & dateiname & " gewählt"
'enfügen einer Zeile (Zeile 3)
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Range("A2").Select
End If
Workbooks.Open Filename:=dateiname
Windows.Arrange ArrangeStyle:=xlHorizontal
Windows("00_uebersicht2.XLS").Activate
'ActiveWindow.Zoom = 50
'aktives Fenster immer Windows (1)--> inaktives Fenster öffnen
Windows(2).Activate
'ActiveWorkbook.Windows(1).Caption = "datei"
Sheets("Tabelle1").Select
Range("C3:F3").Select
Application.CutCopyMode = False
Selection.Copy
Windows("00_uebersicht2.XLS").Activate
ActiveSheet.Paste Link:=True
Windows(2).Activate
Range("C6:F6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("00_uebersicht2.XLS").Activate
Range("B2").Select
ActiveSheet.Paste Link:=True
Windows(2).Activate
Range("C7:F7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("00_uebersicht2.XLS").Activate
...
Windows(2).Activate
Range("A1:F1").Select
ActiveWindow.Close
ActiveWindow.WindowState = xlMaximized
'ActiveWindow.Zoom = 100
' Range("A1:F1").Select
Range("A3:ci3").Select
Selection.Copy
Range("A2:ci2").Select
Range("ba2").Activate
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
' Range("A3").Select
' Selection.End(xlToRight).Select
Range("Ax3:az3").Select
Selection.Copy
Range("Ax2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("ch3:ci3").Select
Selection.Copy
Range("ch2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Range("A1:ba400").Select
'Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Key3:=Range("A2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Range("d2").Select
Range("A1").Select
'Range(Selection, Selection.End(xlDown)).Select
'Range(Selection, Selection.End(xlToRight)).Select
'Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Key3:=Range("A2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A2").Select
GoTo 1
2
End Sub
Moderation,4: CODE tags gesetzt
Ich habe mir nach langen Probieren ein Makro in Excel erstellt, welches Zellwerte aus einzelnen Dateien in eine Übersichtsdatei als Verknüpfung einfügt. Dazu wird der Dateiname der ersten Datei abgefragt und dann automatisch Zelle für Zelle in die Übersichtsdatei übernommen.
Dieses Makro ist für mich sehr wichtig und hält mich davon ab endlich auf Open/Libreoffice umzusteigen. Die Versuche meinerseits das Makro in Open/Libreoffice umzuwandeln enden mit etlichen Fehlermeldungen.
Wo liegt mein Problem- kann mir jemand helfen?
hier die gekürzte Fassung:
[code]Sub a_Tabellen_einbinden()
'
' Makro2 Makro
' Makro am 10.10.2001 von Wellkisch aufgezeichnet
'
1
'
'Fügt Daten der Datei "Dateiname" in Datei Übersicht.xls ein
Dim dateiname As String
'Dim datei As String
'Aufruf des Dateidialoges
dateiname = Application.GetOpenFilename
'wenn Abbrechen oder ESC gedückt wurde
If dateiname = "Falsch" Then
'MsgBox "Sie haben keine Datei gewählt!"
GoTo 2
' Sonst wird die gewählte Datei angezeigt
Else
'MsgBox "Sie haben die Datei " & dateiname & " gewählt"
'enfügen einer Zeile (Zeile 3)
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Range("A2").Select
End If
Workbooks.Open Filename:=dateiname
Windows.Arrange ArrangeStyle:=xlHorizontal
Windows("00_uebersicht2.XLS").Activate
'ActiveWindow.Zoom = 50
'aktives Fenster immer Windows (1)--> inaktives Fenster öffnen
Windows(2).Activate
'ActiveWorkbook.Windows(1).Caption = "datei"
Sheets("Tabelle1").Select
Range("C3:F3").Select
Application.CutCopyMode = False
Selection.Copy
Windows("00_uebersicht2.XLS").Activate
ActiveSheet.Paste Link:=True
Windows(2).Activate
Range("C6:F6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("00_uebersicht2.XLS").Activate
Range("B2").Select
ActiveSheet.Paste Link:=True
Windows(2).Activate
Range("C7:F7").Select
Application.CutCopyMode = False
Selection.Copy
Windows("00_uebersicht2.XLS").Activate
...
Windows(2).Activate
Range("A1:F1").Select
ActiveWindow.Close
ActiveWindow.WindowState = xlMaximized
'ActiveWindow.Zoom = 100
' Range("A1:F1").Select
Range("A3:ci3").Select
Selection.Copy
Range("A2:ci2").Select
Range("ba2").Activate
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
' Range("A3").Select
' Selection.End(xlToRight).Select
Range("Ax3:az3").Select
Selection.Copy
Range("Ax2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("ch3:ci3").Select
Selection.Copy
Range("ch2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Range("A1:ba400").Select
'Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Key3:=Range("A2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Range("d2").Select
Range("A1").Select
'Range(Selection, Selection.End(xlDown)).Select
'Range(Selection, Selection.End(xlToRight)).Select
'Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Key3:=Range("A2"), Order3:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A2").Select
GoTo 1
2
End Sub[/code]
[color=#800000]Moderation,4[/color]: CODE tags gesetzt