Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
Mittels Button Werte aus alter Tabelle ("x") in neue übertragen und mit Bezeichnung abgl. |
29.05.2022 10:29:17 |
Martin |
|
|
|
30.05.2022 10:04:28 |
Gast15617 |
|
|
|
31.05.2022 14:56:48 |
Martin |
|
|
Von:
Martin |
Datum:
29.05.2022 10:29:17 |
Views:
765 |
Rating:
|
Antwort:
|
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
|
- 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
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- 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
|
Mittels Button Werte aus alter Tabelle ("x") in neue übertragen und mit Bezeichnung abgl. |
29.05.2022 10:29:17 |
Martin |
|
|
|
30.05.2022 10:04:28 |
Gast15617 |
|
|
|
31.05.2022 14:56:48 |
Martin |
|
|