Thema Datum  Von Nutzer Rating
Antwort
Rot Mittels Button Werte aus alter Tabelle ("x") in neue übertragen und mit Bezeichnung abgl.
29.05.2022 10:29:17 Martin
NotSolved
30.05.2022 10:04:28 Gast15617
NotSolved
31.05.2022 14:56:48 Martin
NotSolved

Ansicht des Beitrags:
Von:
Martin
Datum:
29.05.2022 10:29:17
Views:
113
Rating: Antwort:
  Ja
Thema:
Mittels Button Werte aus alter Tabelle ("x") in neue übertragen und mit Bezeichnung abgl.

Hallo liebes VBA Team,

Bin hier auf folgendes Problem gestoßen:

  • Ich möchte gerne mittels eines Buttons eine Excel Datei öffnen!
  • Dann soll diese die Tabellenblätter zwischen der alten und neuen Datei abgleichen! (z.B. Tabelle1 mit Tabelle1, Tabelle2 mit Tabelle 2, etc...)
  • Anschließend Prüfen anhand der Bezeichnung (Spalte B) ob in der Spalte daneben (Spalte C) ein "x" eingetragen ist und wenn vorhanden diese in die neue übernehmen! Bei der neuen Datei sind meisten neue Zeilen (Einträge) eingefügt

Hier das Beispiel:

Tabelle (alt)

Tabelle (alt)
# Bezeichnung Erhalten
1 C_01 x
2 C_02 x
3 C_03 x
4 C_04 x
5 C_05 x
6 C_06 x
7 C_07 x
8 C_08 x
9 C_09 x
10 C_10 x
     
     
     
     

Tabelle (neu)

Tabelle (neu)
# Bezeichnung Erhalten
1 C_01 x
2 C_02 x
3 C_02_P1 (neu)  
4 C_03 x
5 C_04 x
6 C_05 x
7 C_06 x
8 C_07 x
9 C_08 x
10 C_09 x
11 C_10 x
12 C_11  
     
     

Habe schon einen Makro für ein Modul gebastelt, schaffe es aber nicht die Überprüfung/abgleich herzustellen:


Sub Daten_Importieren_()

Dim Dateiname As Variant
Dim WBQuelle As Workbook

'ScreenUpdating und PopUps deaktivieren
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Dateiauswahl per Benutzer
Dateiname = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.xls*),*.xls*")

'Wurde eine Datei ausgewählt
If Dateiname <> False Then
   
    'Arbeitsmappe öffnen
    Set WBQuelle = Workbooks.Open(Filename:=Dateiname)
       
    'Daten kopieren und einfügen
    'Tabelle1
    WBQuelle.Worksheets("Tabelle1").Range("C05:C500").Copy
    ThisWorkbook.Worksheets("Tabelle1").Range("C05:C500").PasteSpecial Paste:=xlPasteValues


'Arbeitsmappe schließen
    WBQuelle.Close SaveChanges:=False
      

End If

'ScreenUpdating und PopUps aktivieren
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Sheets("Tabelle1").Select

End Sub

Vielen Dank im voraus!

Mit freundlichen Grüßen 

Martin


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Mittels Button Werte aus alter Tabelle ("x") in neue übertragen und mit Bezeichnung abgl.
29.05.2022 10:29:17 Martin
NotSolved
30.05.2022 10:04:28 Gast15617
NotSolved
31.05.2022 14:56:48 Martin
NotSolved