Excel VBA - Bereiche kopieren und an anderer Stelle einfügen

Question

Hallo Excel-Freunde,

ich hab da ein kleines Problem:

Ich möchte einen bestimmten Bereich auf einem Tabellenblatt ("Anhang") via VBA in ein anderes Tabellenblatt ("Anhang Kopie") kopieren. Die schwierigkeit dabei ist, dass im Tabellenblatt ("Anhang") mehrere Spalten mit Werten gefüllt sind (Spalte A bis AS) und ich diese Werte in das Tabellenblatt ("Anhang Kopie") untereinander in nur eine Spalte kopieren möchte. Dabei ist die Zeilenanzahl mit gefüllten Werten in den Spalten der Tabelle ("Anhang") immer unterschiedlich. D.h. die Spalten hängen von einer im Vorfeld getroffen Auswahl ab und haben dementsprechend immer andere Werte (unteranderen auch doppelte Werte).

Meine Frage ist nun: Wie kann ich per VBA nur die Spalten der Tabelle ("Anhang"), in denen ein Wert steht kopieren (mit immer unterschiedlicher Zeilenanzahl) und in die Spalte A ins Tabellenblatt ("Anhang Kopie") untereinander einfügen? Dabei sollen auch gleich alle doppelten Werte gelöscht werden.


Ist das irgendwie machbar? Ich weiß nicht wie ich dem Programm sage, dass er nur die Zellen in der jeweiligen Spalte kopiert, welche einen Wert enthalten und dann diese dann im anderen Tabellenblatt in Spalte A untereinander ohne doppelte Werte einfügt.

Für Hilfe wäre ich sehr dankbar.

Grüße
Steffen

Answer 1

Hi,

Das würde ich in Angriff nehmen, wie folgt:

Sub Anhang_Kopie()
Dim shQuelle As Worksheet, shZiel As Worksheet
Dim varScratch As Variant
Dim lngQLRS As Long, lngZLR As Long
Dim lngQS As Long, lngQR As Long

Set shQuelle = ThisWorkbook.Sheets("Anhang")
Set shZiel = ThisWorkbook.Sheets("Anhang Kopie")

For lngQS = 1 To 45 Step 1 'Spalten A=1 bis AS=45
lngQLRS = shQuelle.Cells(Rows.Count, lngQS).End(xlUp).Row 'letzte Zeile in der Spalte
For lngQR = 1 To lngQLRS Step 1 'von Zeile1 bis letzte Zeile der Spalte
varScratch = shQuelle.Cells(lngQR, lngQS).Value
If varScratch <> "" Then 'wenn Zelle nicht leer
If WorksheetFunction.CountIf(shZiel.Range("A:A"), varScratch) = 0 Then 'wenn Wert in Kopie,Spalte A nicht vorhanden
lngZLR = shZiel.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 'Zielzeile in Anhang Kopie SpalteA=1 ermitteln
shZiel.Cells(lngZLR, 1).Value = varScratch 'Wert in Zielzelle einfügen
End If
End If
Next
Next

Set shQuelle = Nothing
Set shZiel = Nothing

End Sub

Kopiere diesen Code in ein StandardModul und starte ihn über eine Tastenkombination oder eine Befehlsschaltfläche. (Erste Tests bitte an einer Testmappe oder einer Kopie der "echten" Mappe.)

bye
malSchauen

Answer 2

Hi,

vielen Dank für die schnelle Antwort! Es funktioniert!!!!! Da wär ich ja nie drauf gekommen :-) Wie macht ihr Spezis das nur...unglaublich!

Also nochmal Danke!


Gruß
Steffen