Clever-Excel-Forum

Moin,

Ich kenne mich noch nicht sehr gut in VBA aus.  :22:

Ich möchte den gesamten Inhalt von Tabelle A kopieren und unterhalb Tabelle B auf einem anderen Blatt im selben Dokument einfügen. (Im weiteren Schritt nutze ich dann Duplikate löschen um alles doppelte los zu werden, das bekomme ich jedoch selbst noch über Makro aufzeichnen hin)

Wenn ich das jedoch in Foren suche, komme ich immer auf Anfragen mit sehr viel mehr Bedingungen und tue mich etwas schwer herauszufiltern, welchen Code ich für meine Bedürfnisse ausreicht... Erbarmt sich jemand mir die entsprechenden Befehle zu verraten?

LG,
Frido

Hallo Frido,

Sub abc()

  ActiveSheet.Cells(1).CurrentRegion.Copy Worksheets("Tabelle 2").Cells(Rows.Count, 1).End(xlUp).Offset(1)

End Sub

Gruß Uwe

Moin, hat ein wenig gedauert. Ich habe es nach etwas hinbekommen und dank deiner Formel gelöst. Hier der ganze Code falls es noch andere interessiert. So langsam komme ich auch hinter die Logik von VBA und setze mich als nächstes daran alle unnötigen "Select" Schritte rauszuwerfen die durch meine unbeholfenen Aufzeichnungen rein gekommen sind. Wenn jemand lust hat mir Tipps zu geben, wie der Code zu verschlanken ist, immer her damit ;)

Sub Alle Arbeitsschritte()
'
' Datum_Setzen Makro
' Setzt das heute Datum an alle Datensätze in der Tabelle Aupake-Exporte. Später werden nur noch nicht vorhandene Datensätze übernommen, wodurch immer das Datum des Erstexports pro Datensatz übrig bleibt.
'
'Aktualisiert die Daten über Powerquery
    ActiveWorkbook.RefreshAll

'Setzt heutiges Datum
    Sheets("Import").Select
    Range("Aupake_Exporte[Datum]").Select
    Selection.FormulaR1C1 = Date
'
' Kopieren Makro
' Alle Daten aus Aupake_Exporte in Anmeldungen anfügen
'
    With Worksheets("Aupake Anmeldungen").ListObjects("Anmeldungen").ListRows.Add
   
    Sheets("Import").ListObjects("Aupake_Exporte").DataBodyRange.Copy
   
    .Range.Cells(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                :=False, Transpose:=False
    End With

'
' Entstandene Duplikate_löschen Makro
' Löscht Duplikate anhand Name und Booking number (U und V), lässt jeweils ersten Eintrag stehen
'

    Sheets("Aupake Anmeldungen").ListObjects("Anmeldungen").Range.RemoveDuplicates Columns:=Array(21, 22), Header:=xlYes

'
' Dropdown Makro
' Richtet ein Dropdown für Liste "Anmeldung" ein.
'

'
    Sheets("Aupake Anmeldungen").Select
    Range("Anmeldungen[Anfrage/Zusage/Absage/Campleiter]").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=Import!$X$2:$X$9"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "Achtung"
        .InputMessage = ""
        .ErrorMessage = "Wähle aus dem Dropdown aus"
        .ShowInput = False
        .ShowError = True
    End With
'
' Fülle_Betreuerdatenbank Makro
' Sortiert den Import nach Datum absteigend, kopiert alle Daten und löscht bei Duplikaten die ältesten Einträge.
'

    'Sortiere nach Datum absteigend
    Sheets("Aupake Anmeldungen").Select
    ActiveWorkbook.Worksheets("Aupake Anmeldungen").ListObjects("Anmeldungen").Sort _
        .SortFields.Clear
    ActiveWorkbook.Worksheets("Aupake Anmeldungen").ListObjects("Anmeldungen").Sort _
        .SortFields.Add2 Key:=Range("Anmeldungen[[#All],[Datum]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Aupake Anmeldungen").ListObjects("Anmeldungen") _
        .Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    'Kopiere Spalten Datum von Anmeldungen nach Datenbank
    Sheets("Aupake Anmeldungen").Select
    Range( _
        "Anmeldungen[[#All],[Datum]]" _
        ).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Betreuerdatenbank").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    'Kopiere Spalten Land-Mobile von Anmeldungen nach Datenbank
    Sheets("Aupake Anmeldungen").Select
    Range( _
        "Anmeldungen[[#All],[Wann und wo (in welchem Land) warst du mit AFS im Ausland?]:[Mobile]]" _
        ).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Betreuerdatenbank").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
    'Kopiere Spalten Bundesland von Anmeldungen nach Datenbank
    Sheets("Aupake Anmeldungen").Select
    Range("Anmeldungen[[#All],[In welchem Bundesland wohnst du aktuell?]]").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Betreuerdatenbank").Select
    Range("J1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'Kopiere Spalten Betreute Camps von Anmeldungen nach Datenbank
    Sheets("Aupake Anmeldungen").Select
    Range( _
        "Anmeldungen[[#All],[Welche Camps hast du schon betreut? Hast du schon mal die Campleitung übernommen?]]" _
        ).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Betreuerdatenbank").Select
    Range("R1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
    'Kopiere Spalten Unverträglichkeiten-Name von Anmeldungen nach Datenbank
    Sheets("Aupake Anmeldungen").Select
    Range( _
        "Anmeldungen[[#All],[Lebensmitteleinschränkungen/Lebensmittelunverträglichkeiten]:[Name]]" _
        ).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Betreuerdatenbank").Select
    Range("S1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
    'Lösche Doppelte Namen (Refernezspalte T) Erster Wert bleibt erhalten.
    Sheets("Betreuerdatenbank").ListObjects("Datenbank").Range.RemoveDuplicates Columns:=21, Header:=xlYes
   
'Formatierungen löschen
    Sheets("Betreuerdatenbank").Cells.Range("Datenbank[[#Headers],[Anmeldungen]]").Activate
    Cells.FormatConditions.Delete

'Lösche Inhalte
    Range("Datenbank[[Anmeldungen]:[Nicht zurückgemeldet]]").ClearContents

'Setze Formeln
    Sheets("Betreuerdatenbank").Range("K2").FormulaR1C1 = "=COUNTIF(Anmeldungen[Name],[@Name])"
    Sheets("Betreuerdatenbank").Range("L2").FormulaR1C1 = _
        "=COUNTIFS(Anmeldungen[Name],[@Name],Anmeldungen[Anfrage/Zusage/Absage/Campleiter],Datenbank[[#Headers],[Zugesagt]])"
    Sheets("Betreuerdatenbank").Range("M2").FormulaR1C1 = _
        "=COUNTIFS(Anmeldungen[Name],[@Name],Anmeldungen[Anfrage/Zusage/Absage/Campleiter],Datenbank[[#Headers],[Zugesagt CL]])"
    Sheets("Betreuerdatenbank").Range("N2").FormulaR1C1 = _
        "=COUNTIFS(Anmeldungen[Name],[@Name],Anmeldungen[Anfrage/Zusage/Absage/Campleiter],Datenbank[[#Headers],[Abgesagt selbst]])"
    Sheets("Betreuerdatenbank").Range("O2").FormulaR1C1 = _
        "=COUNTIFS(Anmeldungen[Name],[@Name],Anmeldungen[Anfrage/Zusage/Absage/Campleiter],Datenbank[[#Headers],[Abgesagt wir]])"
    Sheets("Betreuerdatenbank").Range("P2").FormulaR1C1 = _
        "=COUNTIFS(Anmeldungen[Name],[@Name],Anmeldungen[Anfrage/Zusage/Absage/Campleiter],Datenbank[[#Headers],[Kurzfristig Abgesagt]])"
    Sheets("Betreuerdatenbank").Range("Q2").FormulaR1C1 = _
        "=COUNTIFS(Anmeldungen[Name],[@Name],Anmeldungen[Anfrage/Zusage/Absage/Campleiter],Datenbank[[#Headers],[Nicht zurückgemeldet]])"

'Formatierung setzen
    Columns("K:M").Select
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    Columns("N:Q").Select
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
   
End Sub