Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


Code von Tabellenblatt in Modul
#1
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.
LG Herbert
Windows 7
Excel 2010
to top
#2
(09.05.2014, 08:54)herbert0803 schrieb: 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.
Gruß
to top
#3
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?


Angehängte Dateien
.xlsm   Testdatei1.xlsm (Größe: 58,35 KB / Downloads: 3)
.xlsx   Summen.xlsx (Größe: 164,74 KB / Downloads: 5)
LG Herbert
Windows 7
Excel 2010
to top
#4
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
Gruß
to top
#5
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
Gruß Atilla

Excel 2007
to top
#6
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?
LG Herbert
Windows 7
Excel 2010
to top
#7
Hallo Herbert,

dann schreib überall statt:

Range("Datum")

so, wie Du es an manschen Stellen schon hast:

curWks.Range("Datum")
Gruß Atilla

Excel 2007
to top
#8
[/quote]Hallo Atilla,

(09.05.2014, 12:46)atilla schrieb: 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?
Zitat: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
LG Herbert
Windows 7
Excel 2010
to top
#9
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.
Gruß Atilla

Excel 2007
to top
#10
Hallo Atilla,

danke für den Link.
Damit habe ich die Abfrage ob die Datei geöffnet ist hinbekommen.
LG Herbert
Windows 7
Excel 2010
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  Modul einzeln kopieren heli 5 617 17.11.2015, 11:14
Letzter Beitrag: heli
  Name der aktiven Userform im Modul feststellen ChristaRohn 4 932 05.09.2015, 10:15
Letzter Beitrag: RPP63
  Modul läuft unter Excel 2013 nicht mehr Glausius 18 3.248 17.04.2015, 14:40
Letzter Beitrag: Glausius
  VBA Modul Passwort schützen wavemaster 2 2.151 08.02.2015, 14:20
Letzter Beitrag: wavemaster
  Code vorübergehend per Code ändern! cysu11 9 1.681 11.12.2014, 19:06
Letzter Beitrag: cysu11
  zurück aus Form zum Modul DeBabba 4 887 10.10.2014, 12:56
Letzter Beitrag: DeBabba

Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste