gleiches Sheet u. Zelle in div. Workbooks markiere

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Sepp
Vielen Dank für deine Rückmeldung.
Der Hintergrund ist Folgender.
Ich habe eine Menge gleicher Dateien, die vom Layout zuletzt gleich aussehen müssen (die Dateien sind mit unterschiedlichem Datenmaterial gefüllt). Leider wurde das Layout im Laufe des Erstellungsprozesses immer wieder geändert. Da ich nun in über 20 Dateien Änderungen vornehmen muss, möchte ich die jeweils zu ändernden Zellen nur einmal anwählen und mit einem Automatismus die gleichen Bereiche auswählen.
Meine Vorstellung wird dann noch weiter gehen (ich dachte, alles Schritt um Schritt). Und zwar will ich dann den Ausgangsbereich kopieren und in den anderen Dateien einsetzen. Da ich zum Teil bestimmten Bereichen Namen vergebe, muss ich jeweils auch bestätigen, dass die vorhandene Definiion von XXX (=Name) verwendet werden soll (Bejahung der Excel-Anfrage: "Die Formel, die eingefügt werden soll, enthält einen Namen, der bereits in der Zieltabelle vorhanden ist. Soll die vorhandene Definition von XXX verwendet werden?"). Da ich dies immer bejahen werde, sollte dies auch automatisch ablaufen.
Freundlicher Gruss
Peter

Hallo Peter!
Um die Zellen komplett zu Übertragen, nimm diesen Code.

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Uebertragen()
Dim objWB As Workbook
Dim objName As Name
Dim rng As Range

On Error Resume Next
GetMoreSpeed

For Each objWB In Application.Workbooks

  If Not objWB Is ThisWorkbook Then
    Selection.Copy objWB.Sheets(ActiveSheet.Name).Range(Selection.Address)
  End If

Next

Err.Clear
GetMoreSpeed 0
On Error GoTo 0
End Sub

Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)
Static lngCalc As Long

With Application
  If Modus = 1 Then
    lngCalc = .Calculation
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Calculation = -4135
    .Cursor = xlWait
  Else
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    .Calculation = IIf(lngCalc <> 0, lngCalc, -4105)
    .Cursor = xlDefault
  End If
End With

End Sub

Das mit den Namen hab ich nicht ganz kapiert, und das wird auch nicht so leicht gehen, weil man auf die richtigen Bezüge achtgeben muss.

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

gleiches Sheet u. Zelle in div. Workbooks markiere

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread