Code von Tabellenblatt in Modul

[herbert0803]

Hallo zusammen!

Ich habe eine Excel Datei mit mehreren Tabellenblättern.
Die Tabellenblätter sind gleich aufgebaut.
Hinter jedem Tabellenblatt ist ein Code, der bestimmte Zellinhalte in eine Sammeldatei überträgt.
Die Zellen deren Inhalte übertragen werden sollen, sind als Namen definiert. Die Namen lauten in jedem Tabellenblatt gleich.
Die Tabellenblätter in der Sammeldatei haben einmal den gleichen Namen wie in der Ursprungsdatei und für einen zweiten Übertrag ist dem gleichen Namen ein Zusatz (ÖNB) vorangestellt.
Der Code funktioniert einwandfrei.
Ich möchte den Code jetzt nicht mehr in jedem Tabellenblatt haben, sondern nur einmal in einem Modul. Dadurch muss ich bei Änderungen nicht mehrere Codes ändern, sondern nur einen.
Dazu habe ich den Tabellenblattnamen variabel gestaltet.
Wenn ich den Code in ein Modul kopiere, kommt bei der Ausführung ein Laufzeitfehler '1004'
"Die Methode 'Range' für das Objekt '_Global' ist fehlgeschlagen". Als Fehler wird der Bereich 'DATUMSABFRAGE Datprüf = Range("Datum") markiert.

Code:

Option Explicit
Sub Datenweitergabe()
    Dim LoLetzte As Long
    Dim inAbfrage As Integer
    Dim DatName As String, DatPfad As String
    Dim curWkb As Workbook, curWks As Worksheet
    Dim Datprüf  'As String
    Dim msga As String 'Definition Msgboxvariable "Datensatz vorhanden ..."
    Dim suchvar As Range
    Dim BstName As String
    
      
    Datprüf = Range("Datum") 'Variabel für Datum
    DatName = "BA_Summen.xlsx" 'Dateiname anpassen
    DatPfad = "C:\Vorlagen-Muster\TESTS" & "\" 'Dateipfad anpassen
    BstName = ActiveSheet.Name  'Variable für Tabellenblatt
    
    Application.ScreenUpdating = False
    
    Set curWkb = Workbooks(ActiveWorkbook.Name)
    Set curWks = curWkb.Worksheets(ActiveSheet.Name)
    curWks.Range("Datum").Copy
    Workbooks.Open DatPfad & DatName
    
    'DATUMSABFRAGE
     Datprüf = Range("Datum")
     Set suchvar = Worksheets(BstName).Range("A:A").Find(What:=Datprüf, LookIn:=xlValues, LookAt:=xlWhole)
      
        If Not suchvar Is Nothing Then
            msga = MsgBox("Datensatz mit diesem Datum bereits vorhanden. Weiteren Datensatz übertragen?", vbYesNo, "Info")
                If msga = vbNo Then
                    Workbooks(DatName).Save
                    Workbooks(DatName).Close
                    Application.ScreenUpdating = True
                    Exit Sub
                Else
                    GoTo datübertrag
                End If
        Else
            GoTo datübertrag
    
        End If



datübertrag:  'Marke aus Abfrage MsgBox oben

    'Übertrag für Sammeldatei

    With Workbooks(DatName).Worksheets(BstName)
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("A" & LoLetzte + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
        curWks.Range("Datum").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("A" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    
        curWks.Range("Stand100").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("B" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("Stand50").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("C" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("Stand20").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("D" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("Stand10").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("E" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("GS_vor").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("F" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("NF_100").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("G" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("NF_50").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("H" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("NF_20").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("I" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("NF_10").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("J" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("GS_nach").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("K" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    
    End With
        
    'Übertrag für ÖNB
        
        With Workbooks(DatName).Worksheets("ÖNB " & BstName)
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("A" & LoLetzte + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
        curWks.Range("Datum").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("A" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    
        curWks.Range("GSA_100").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("B" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_HA100").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("C" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_Bst100").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("D" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("GSA_50").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("E" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_HA50").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("F" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_Bst50").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("G" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("GSA_20").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("H" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_HA20").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("I" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_Bst20").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("J" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("GSA_10").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("K" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_HA10").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("L" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_Bst10").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("M" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("Bef_Ges").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("N" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        
    End With
    
    Workbooks(DatName).Save
    Workbooks(DatName).Close
    Application.ScreenUpdating = True
    
    MsgBox ("Die Werte wurden übertragen")
                    
End Sub

Was muss ich ändern?
Der Code wurde vor längerer Zeit mit Hilfe des alten Forums erstellt. Ich kenn mich mit VBA wenig aus.
Falls jemandem noch andere Verbesserungsmöglichkeiten auffallen bin ich natürlich für Änderungen empfänglich.

[Gardinenhaken]

Hallo zusammen!

Ich habe eine Excel Datei mit mehreren Tabellenblättern.
Die Tabellenblätter sind gleich aufgebaut.
Hinter jedem Tabellenblatt ist ein Code, der bestimmte Zellinhalte in eine Sammeldatei überträgt.
Die Zellen deren Inhalte übertragen werden sollen, sind als Namen definiert. Die Namen lauten in jedem Tabellenblatt gleich.
Die Tabellenblätter in der Sammeldatei haben einmal den gleichen Namen wie in der Ursprungsdatei und für einen zweiten Übertrag ist dem gleichen Namen ein Zusatz (ÖNB) vorangestellt.
Der Code funktioniert einwandfrei.
Ich möchte den Code jetzt nicht mehr in jedem Tabellenblatt haben, sondern nur einmal in einem Modul. Dadurch muss ich bei Änderungen nicht mehrere Codes ändern, sondern nur einen.
Dazu habe ich den Tabellenblattnamen variabel gestaltet.
Wenn ich den Code in ein Modul kopiere, kommt bei der Ausführung ein Laufzeitfehler '1004'
"Die Methode 'Range' für das Objekt '_Global' ist fehlgeschlagen". Als Fehler wird der Bereich 'DATUMSABFRAGE Datprüf = Range("Datum") markiert.


Was muss ich ändern?
Der Code wurde vor längerer Zeit mit Hilfe des alten Forums erstellt. Ich kenn mich mit VBA wenig aus.
Falls jemandem noch andere Verbesserungsmöglichkeiten auffallen bin ich natürlich für Änderungen empfänglich.

Hallo Herbert,

das ist eine klare Aufgabenstellung und der Schuldige ist eigentlich auch schon ausgemacht :19:

Trotzdem bitte ich Dich darum, die Datei zur Verfügung zu stellen, damit das vernünftig getestet werden kann.

[herbert0803]

Hallo Peter,

anbei die Beispieldateien.
Ich hoffe es funktioniert

Noch eine Zusatzfrage.

Ist es möglich vor dem Übertrag zu prüfen ob die Summendatei bereits geöffnet ist?
Wenn ja, den Übertrag abbrechen und eine Messagebox mit dem User der die Datei im Netzwerk in Bearbeitung hat anzuzeigen?

Wenn es möglich ist, wie?

[Gardinenhaken]

Hallo Herbert,

Ist es möglich vor dem Übertrag zu prüfen ob die Summendatei bereits geöffnet ist?
Wenn ja, den Übertrag abbrechen und eine Messagebox mit dem User der die Datei im Netzwerk in Bearbeitung hat anzuzeigen?


ich mache dann mal lieber den Weg frei, für Helfer mit Netzwerkerfahrung.
Sowas geht mir völlig ab ... mit anderen Worten, ich habe keine Ahnung von Netzlaufwerkem.

Ich werde aber jetzt aufpassen und mitlernen :19:

[atilla]

Hallo Herbert,

zu Deiner ersten Frage:

Du hast bei der Benennung der Datumszelle die verbundenen Zellen als Bezug.
Ändere den Zellbezug auf die erste Zelle der verbundenen Zellen.

Z.B:

Bisher sieht der Bezug so aus: ='FB1'!$D$39:$E$39

diesen so ändern ='FB1'!$D$39

[herbert0803]

Hallo Atilla,

die Änderung habe ich gemacht, auch bei anderen Bezügen.
Der Fehler bleibt trotzdem.

Liegt es vielleicht daran, dass der Name "Datum" in allen Arbeitsmappen vorkommt?

[atilla]

Hallo Herbert,

dann schreib überall statt:

Range("Datum")

so, wie Du es an manschen Stellen schon hast:

curWks.Range("Datum")

[herbert0803]

[/quote]Hallo Atilla,

Hallo Herbert,

dann schreib überall statt:

Range("Datum")

so, wie Du es an manschen Stellen schon hast:

curWks.Range("Datum")

Damit funktioniert es. Ich hab dann auch noch versucht den einen Teil, der als Fehler angezeigt wird überhaupt weg zu lassen. Dann funktioniert es auch.
Hier meine Änderungen:

Datprüf = Range("Datum") 'Variabel für Datum -> diesen Teil auf Datprüf = curWks.Range("Datum") geändert DatName = "BA_Summen.xlsx" 'Dateiname anpassen
DatPfad = "C:\Vorlagen-Muster\TESTS" & "\" 'Dateipfad anpassen
BstName = ActiveSheet.Name 'Variable für Tabellenblatt

Application.ScreenUpdating = False

Set curWkb = Workbooks(ActiveWorkbook.Name) -> Diese Zeilen vor die o. g. Zeile verschoben
Set curWks = curWkb.Worksheets(ActiveSheet.Name) -> Diese Zeilen vor die o. g. Zeile verschoben
curWks.Range("Datum").Copy
Workbooks.Open DatPfad & DatName

'DATUMSABFRAGE
Datprüf = Range("Datum") -> diesen Teil gelöscht

Somit ist die erste Frage erledigt. Danke!

Hat jemand noch eine Antwort auf die 2. Frage?

Ist es möglich vor dem Übertrag zu prüfen ob die Summendatei bereits geöffnet ist?
Wenn ja, den Übertrag abbrechen und eine Messagebox mit dem User der die Datei im Netzwerk in Bearbeitung hat anzuzeigen?

Hier nochmals der jetzt geänderte vollständige Code:

Code:

Option Explicit
Sub Datenweitergabe()
    Dim LoLetzte As Long
    Dim inAbfrage As Integer
    Dim DatName As String, DatPfad As String
    Dim curWkb As Workbook, curWks As Worksheet
    Dim Datprüf  'As String
    Dim msga As String 'Definition Msgboxvariable "Datensatz vorhanden ..."
    Dim suchvar As Range
    Dim BstName As String
    
      
    DatName = "Summen.xlsx" 'Dateiname anpassen
    DatPfad = "Y:\TESTS" & "\" 'Dateipfad anpassen
    BstName = ActiveSheet.Name  'Variable für Tabellenblatt als Bankstellenname
    
    Set curWkb = Workbooks(ActiveWorkbook.Name)
    Set curWks = curWkb.Worksheets(ActiveSheet.Name)
    
    Datprüf = curWks.Range("Datum") 'Variable für Datum

    Application.ScreenUpdating = False
    
    curWks.Range("Datum").Copy
    Workbooks.Open DatPfad & DatName
    
    'DATUMSABFRAGE
     Set suchvar = Worksheets(BstName).Range("A:A").Find(What:=Datprüf, LookIn:=xlValues, LookAt:=xlWhole)
      
        If Not suchvar Is Nothing Then
            msga = MsgBox("Datensatz mit diesem Datum bereits vorhanden. Weiteren Datensatz übertragen?", vbYesNo, "Info")
                If msga = vbNo Then
                    Workbooks(DatName).Save
                    Workbooks(DatName).Close
                    Application.ScreenUpdating = True
                    Exit Sub
                Else
                    GoTo datübertrag
                End If
        Else
            GoTo datübertrag
    
        End If



datübertrag:  'Marke aus Abfrage MsgBox oben

    'Übertrag für Sammeldatei

    With Workbooks(DatName).Worksheets(BstName)
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("A" & LoLetzte + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
        curWks.Range("Datum").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("A" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    
        curWks.Range("Stand100").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("B" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("Stand50").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("C" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("Stand20").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("D" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("Stand10").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("E" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("GS_vor").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("F" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("NF_100").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("G" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("NF_50").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("H" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("NF_20").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("I" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("NF_10").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("J" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("GS_nach").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("K" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    
    End With
        
    'Übertrag für ÖNB
        
        With Workbooks(DatName).Worksheets("ÖNB " & BstName)
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("A" & LoLetzte + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
        curWks.Range("Datum").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("A" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    
        curWks.Range("GSA_100").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("B" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_HA100").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("C" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_Bst100").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("D" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("GSA_50").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("E" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_HA50").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("F" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_Bst50").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("G" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("GSA_20").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("H" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_HA20").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("I" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_Bst20").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("J" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("GSA_10").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("K" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_HA10").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("L" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("FIT_Bst10").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("M" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        curWks.Range("Bef_Ges").Copy
        LoLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        .Range("N" & LoLetzte).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        
        
    End With
    
    Workbooks(DatName).Save
    Workbooks(DatName).Close
    Application.ScreenUpdating = True
    
    MsgBox ("Die Werte wurden übertragen")
                    
End Sub

[atilla]

Hallo Herbert,

zu Deiner 2. Frage gibt es unzählige Codebeispiele im WWW.

Z.B. hier: Pruefung_ob_eine_Datei_im_Netz_bereits_geoeffnet_ist

Den User auszulesen scheint aber nicht so einfach zu sein.

[herbert0803]

Hallo Atilla,

danke für den Link.
Damit habe ich die Abfrage ob die Datei geöffnet ist hinbekommen.