Microsoft Excel

Herbers Excel/VBA-Archiv

Zeileninhalt automatisch an andere Excel-Datei kop

Betrifft: Zeileninhalt automatisch an andere Excel-Datei kop von: John Snow
Geschrieben am: 11.12.2015 15:56:54

Guten Tag alle miteinander,

ich bin VBA-Anfänger und habe trotzdem ein (für mich) schwieriges Problem zu lösen.

Folgendes will ich mit Hilfe von VBA realisieren:

Ich habe zwei Excel-Dateien. Wenn jetzt in der einen Excel-Datei (Name: „alt“) in der Zelle G „Abgeschlossen“ steht, soll die ganze Zeile (Also die Spalten A bis G) kopiert und in eine andere Excel-Datei (Name: „neu“) übertragen werden, und zwar in die erste Zeile, die frei ist.

Jetzt kommt die Herausforderung: Dies soll automatisiert geschehen ohne das die Excel-Datei („neu“) geöffnet wird während der Prozedur.

Ich bin auf der Suche nach was verwertbaren in den unendlichen Weiten des Internets auf einen Code gestoßen, der mittels Verweisen den umgekehrten Fall realisiert, d.h. durch den Code greift eine Datei auf eine andere Datei zu und übernimmt bestimmte Zellen. Dies erfolgt ohne, dass die Datei, auf die zugegriffen wird, geöffnet werden muss. Ich glaube, die Verweise sind der einzige Lösungsweg um das obige Problem zu lösen.

Dies ist der besagte Code:

Sub test()
Dim strVerweis As String               'Verweis auf Zelle in anderer Datei
 
'diese Konstanten müssen angepasst werden
Const strPfad = "C:\Users\Adem\Desktop\"          'Pfad zur anderen Datei (mit Backslash am  _
Ende)
Const strDatei = "alt.xlsm"           'Andere Datei
Const strBlatt = "Tabelle1"              'Tabellenblatt
Const strZelle = "A3"                  'Zelladresse
 
strVerweis = "'" & strPfad & "[" & strDatei & "]" & strBlatt & "'!" & strZelle
 
With Workbooks("neu.xlsm").Worksheets("Tabelle1").Cells(4, 4)
   .Formula = "=IF(" & strVerweis & "="""",""""," & strVerweis & ")"    'Formel eintragen
   .Value = .Value                                                      'Forml in Wert  _
umwandeln
End With
 
End Sub

Über jede Hilfe bin ich dankbar!

Falls ich etwas falsch gemacht habe, dann verzeiht mir bitte, dies ist mein erster Eintrag :)

Vielen Dank im Vorraus

John Snow

  

Betrifft: AW: Zeileninhalt automatisch an andere Excel-Datei kop von: Tino
Geschrieben am: 11.12.2015 17:18:47

Hallo,
ich habe es mal so versucht.
Code ist in der Datei alt.xlsm.
Habe noch eine Spalte wo Datum/Uhrzeit eingetragen wird,
wenn dort bereits etwas drin steht wird diese nicht noch einmal übertragen!

Zip entpacken, Code verwendet den Pfad wo auch die alt.xlsm liegt,
also Anpassung ist für Test nicht notwendig!

alt.xmls öffnen, Button drücken, fertig!

https://www.herber.de/bbs/user/102189.zip


Gruß Tino


  

Betrifft: AW: Zeileninhalt automatisch an andere Excel-Datei kop von: John Snow
Geschrieben am: 12.12.2015 12:25:37

Hallo Tino,

zu erst Mal vielen Dank für deine Mühe und die schnelle Antwort!!!
Ich habe mal deine Datei versucht.
Leider gabe es an fett markierten Stelle im folgenden Code eine Fehlermeldung, als ich auf den Button "Speichern in neu" gedrückt habe. Es kam aber keine Meldung, sondern wurde nur Gelb.

Option Explicit

Sub Start()
Dim ArData
Dim sPath$
Dim rngTmp As Range, rngData As Range, rngEx As Range

'Datei neu
sPath = ThisWorkbook.Path
sPath = IIf(Right$(sPath, 1) = "\", sPath, sPath & "\")
sPath = sPath & "neu.xlsm"


With Tabelle1 'Tabelle
    'Range A2 bis G?
    Set rngData = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
    If rngData.Rows(1).Row < 1 Then Exit Sub
    Set rngData = rngData.Resize(, 8)
    
    'Hilfspalten
    Set rngTmp = rngData.EntireRow.Columns(.Columns.Count - 1).Resize(, 2)
    
    'Events ScreenUpdating Calculation abschalten
    Call Events_(False)
    'Hilfsformel eintragen
    rngTmp.Columns(2).FormulaR1C1 = "=IF(AND(RC7=""Abgeschlossen"",RC8=""""),TRUE,ROW())"
    rngTmp.Columns(1).FormulaR1C1 = "=ROW()"
    'Sortieren damit Daten für Übertragung zusammenhängen
    rngTmp.EntireRow.Sort Key1:=rngTmp.Cells(1, 2), Order1:=xlAscending, Header:=xlNo
    
    On Error Resume Next
    'Daten ermitteln
    Set rngEx = rngTmp.Columns(2).SpecialCells(xlCellTypeFormulas, 4)
    If Not rngEx Is Nothing Then
        'Daten in einem Array speichern
        ArData = rngEx.EntireRow.Columns(1).Resize(, 7)
        'rngEx.EntireRow.Delete 'Daten löschen????????
        rngEx.EntireRow.Columns(8) = Now
    End If
    'zurück sortieren
    rngTmp.EntireRow.Sort Key1:=rngTmp.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
    'Hilfszellen löschen
    rngTmp.EntireColumn.Delete
    'Daten übertragen
    If IsArray(ArData) Then
        Call DatenInExcel(sPath, "Tabelle1$A:G", ArData) 
    End If
    
End With
'Events ScreenUpdating Calculation wieder einschalten
Call Events_(True)
End Sub

Ich muss zugeben, dass ich nicht ansatzweise eine Ahnung habe, was du genau gemacht hast :)

Vielen Dank im Vorraus

John Snow


  

Betrifft: AW: Zeileninhalt automatisch an andere Excel-Datei kop von: Tino
Geschrieben am: 12.12.2015 15:25:02

Hallo
kann ich jetzt nicht nachvollziehen?!
Was passiert wenn du dann auf F5 drückst?

Gruß Tino


  

Betrifft: AW: Zeileninhalt automatisch an andere Excel-Datei kop von: John Snow
Geschrieben am: 15.12.2015 19:27:23

Hallo Tino,

hab es jetzt am anderen PC versucht. Der hat Excel 2010 (der vorherige hatte Excel 2016).
Und siehe da: es geht!!!!
Vielen lieben Dank dafür!
Du hast mir sehr geholfen!

Viele Grüße

John Snow


 

Beiträge aus den Excel-Beispielen zum Thema "Zeileninhalt automatisch an andere Excel-Datei kop"