|
Hallo Leute, ich bin Anfängerin in VBA und habe ein Problem, bei dem ihr mir helfen könnt.
Das wäre sehr Nett.
Ich habe eine Mappe 1 und habe in dieser eine Tabelle. Ich habe angefangen ein Makro zu schreiben um automatisch werte zu dieser Mappe 1 hinzuzufügen, idem ich die Mappe 2 auswähle und durch das Makro automatisch öffne. Aus dieser Mappe 2 würde ich gerne die Spalte B und D kopieren und in ein neues erzeugtes Tabellenblatt in Mappe 1 einfürgen. Jetzt hat Mappe 1 ein Tabellenblatt "Haupt" und ein erzeugtes neues Tabellenblatt "Neue Inhalte". Jeetzt würde ich gerne die Werte von "Neue Inhalte" aus Spalte A mit den Werten von "Haupt" aus Spalte E vergleichen. Also aud Dopplung prüfen. in Spalte A "Neue Inhalte" sind mehrer Werte drin wie in Spalte E "Haupt". Die Werte die nicht doppelt sind, sollen alle in das Tabellenblatt "Haupt" an das letzt Element angefügt werden, da ich zwei Spalten habe in " Neue Inhalte" soll zu dem Wert der nicht doppelt ist auch der gehörige Wert aus Spalte B in das "Haupt" Baltt gezogen werden in der Spalte F an das letzt Element natürlich.
Ich habe 2 Module mal angefangen aber funktionieren leider nicht ganz, bis zu einem Teil
Modul 1: Hier Habe ich jetzt nur die Spalte B kopiert und wollte es dann erweitern. Kopieren funktioniert soweit aber beim EInfügen erhalte ich immer eine Fehlermeldung
Sub DateiAuswählen()
'Deklarierung Variable
Dim Dateiname As Variant
'Workbook ist ein VBA-Objekt
Dim wbQuelle As Workbook
Application.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten
'Öffnet Datei-Fenster um Datei auszuwählen
Dateiname = Application.GetOpenFilename(FileFilter:="Excel-Dateien(*.xls*),*.xls*")
'Prüfen ob eine Datei ausgewählt wurde
If Dateiname <> False Then
'Arbeitsmappe öffnen
Set wbQuelle = Workbooks.Open(Filename:=Dateiname
'Daten koperen und einfügen
wbQuelle.Worksheets(1).Columns("B:B").Copy
'Neues Tabellenblat erzeugen in akutellen Excel-Liste
ThisWorkbook.Worksheets.Add.Name = "Kopieter Inhalt"
Fehlermeldung erscheint hier
'Einfügen in die Mappe die das Marko enthält mit PastSpecial-Methode
ThisWorkbook.Worksheets("Neuer Inhalt").Range("A:A").PasteSpecial
'Arbeitsmappe schliesen und kein Änderungen vornehmen
wbQuelle.Close SaveChanges:=False
End If
End Sub
Modul 2: Einfügen geht auch nicht
Option Explicit
Sub DateiAuswählen1()
'Deklarierung Variable
Dim Dateiname As Variant
Dim Zeile As Integer
Dim Spalte As Integer
Dim ls, lz As Integer
Dim i As Integer
Dim s As Integer
'Workbook ist ein VBA-Objekt
Dim wbQuelle As Workbook
Application.ScreenUpdating = False 'Bildschirmaktualisierung ausschalten
'Öffnet Datei-Fenster um Datei auszuwählen
Dateiname = Application.GetOpenFilename(FileFilter:="Excel-Dateien(*.xls*),*.xls*")
'Prüfen ob eine Datei ausgewählt wurde
If Dateiname <> False Then
'Arbeitsmappe öffnen
Set wbQuelle = Workbooks.Open(Filename:=Dateiname)
ThisWorkbook.Worksheets.Add.Name = "Kopieter Inhalt"
Zeile = 1 'Zeilenwert (ab wo eingefügt werden soll) der immer wieder auf 7 zurückgesetzt _
wird, damit er wieder ab diesen Zeilenwert einfügt
lz = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row 'Die letzte Zeile der aktuellenSpalte bestimmen
For i = 2 To lz 'Schleife um die Zeilen der aktuellen Spalte zu durchlaufen
If Worksheets(1).Cells(i, 2) <> "" Then 'Prüfen ob etwas drinnen steht
Worksheets(1).Cells(i, 2).Copy 'wenn etwas drinnen steht, dann diesen Wert kopieren
ThisWorkbook.Worksheets("Neuer Inhalt").Cells(Zeile, 1).PasteSpecial 'xlPasteValues 'Wert einfügen
Zeile = Zeile + 1 'Immer eine Zeile weiterwandern zwecks einfügen
End If
Next i
Application.ScreenUpdating = True 'Bildschirmaktualisierung einschalten
'Arbeitsmappe schliesen und kein Änderungen vornehmen
'wbQuelle.Close SaveChanges:=False
End If
End Sub
Würde mich über eure hilfe freuen.
Grüße
Leni
|