ich habe ein Makro, welches aus Exceldateien Tipps ausließt und diese in eine große Übersicht schreibt. Die Formulare zum Tippen sind xls-Dateien und auch die große Tippliste.
Da ich Excel2010 verwende, kommt beim Öffnen der Excel-Formulare immer die Meldung "Bearbeitung aktivieren".
Kann dies ins Makro eingebaut werden? Ansonsten muss ich die Dateien alle erst einmal öffnen, Bearbeitung aktivieren anklicken und abspeichern, damit ich das Makro verwenden kann.
Danke im Voraus.
Tom
Sub DatenEinlesenNEU()
Dim wbZiel As Workbook, wbQuelle As Workbook, rngDaten As Range, i As Integer
Dim Bereich(1 To 3) As String
Dim Zeile(1 To 3) As Long 'Oberen Index festlegen entsprechend der Anzahl Bereiche die _
Kopiert werden sollen
Set wbZiel = Workbooks.Open(Filename:="C:\Eigene Dateien\Tipplisten Sp24-26.xls") 'Datei in _
_
die die Daten kopiert werden sollen
Bereich(1) = "A4:L4" 'Bereich, der in 1. Tabelle kopiert werden soll
Bereich(2) = "A10:L10" 'Bereich, der in 2. Tabelle kopiert werden soll
Bereich(3) = "A16:L16" 'Bereich, der in 3. Tabelle kopiert werden soll
'Nächste frei Zielzeile in den Tabellen der Zieltabellen ermitteln
For i = 1 To UBound(Zeile)
With wbZiel.Sheets(i)
' Zeile(i) = .UsedRange.Row + .UsedRange.Rows.Count
'Alternative Möglichkeit
'Nachfolgend Spalte wählen in der immer Daten stehen!
Zeile(i) = Application.Max(4, .Cells(125, 4).End(xlUp).Row + 1)
If Zeile(i) = 125 Then MsgBox "Full house": Exit Sub
End With
Next i
Do
'Datendatei öffnen
Datei = Application.Dialogs(xlDialogOpen).Show
If Datei = False Then Exit Sub
Application.ScreenUpdating = False
Set wbQuelle = ActiveWorkbook
'Formate und Daten aus den Bereichen in die Zieltabellen kopieren
For i = 1 To UBound(Bereich)
Set rngDaten = wbQuelle.Sheets(1).Range(Bereich(i))
rngDaten.Copy
With wbZiel.Sheets(i)
.Cells(Zeile(i), "C").PasteSpecial Paste:=xlFormats
.Cells(Zeile(i), "C").PasteSpecial Paste:=xlValues
End With
Zeile(i) = Zeile(i) + 1
Next i
Application.CutCopyMode = False
wbQuelle.Close Savechanges = False
Application.ScreenUpdating = True
wbZiel.Save
Loop Until MsgBox("Weitere Datei bearbeiten?", vbQuestion + vbYesNo, "Daten einlesen") = vbNo
wbZiel.Close
End Sub