Hallöchen,
ich habe ausprobiert und einen VBA-Code gefunden der funktioniert. Nur habe ich die Bereiche nicht dynamisieren können sondern habe die mit fixen Zellbezügen festgelegt. Die von euch vorgeschlagene Variation mit einer Variablen geht nicht. Der Code wird, ohne Fehlermeldung abgearbeitet aber es passiert nichts. HAbe alle möglichen Varianten ausprobiert. NAchfolgend mein Code:
Code:
Sub CSV_kopieren_einfügen()
'
' CSV_kopieren_einfügen Makro
' Kopiert und fügt Daten in "Musikliste-2013" ein
Dim lngletzte As Long
lngletzte = Tabelle1.Cells(Rows.Count, 2).End(xlUp).Row
'Formatiert Überschriften Rahmen - Hintergrundfarbe - Schrift
Range("A1,B1,C1,D1,E1,F1,G1,H1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
'Spalten werden an Breite angepasst
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
ActiveCell.SpecialCells(xlLastCell).Select
'Markierte Zellen werden sortiert
Range("A2:H25000").Select
Worksheets(1).Sort.SortFields.Clear
Worksheets(1).Sort.SortFields.Add2 Key _
:=Range("A2:A25000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
Worksheets(1).Sort.SortFields.Add2 Key _
:=Range("B2:B25000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
Worksheets(1).Sort.SortFields.Add2 Key _
:=Range("C2:C25000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With Worksheets(1).Sort
.SetRange Range("A2:H25000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Markiert in CSV den zu kopierenden Bereich
Range("A2").Select
Range("A2:H2").Select
Range(Selection, Selection.End(xlDown)).Select
'Kopiert den selektierten Bereich
Selection.Copy
'Aktiviert Datei "Kusikliste" und das Arbeitsblatt "Songliste ABC"
Windows("Musikliste-2023_01.xlsm").Activate
Sheets("Songliste-ABC").Select
Range("A2").Select
Rem letzte zeile einer spalte ermitteln und aktivieren
[A:A].SpecialCells(xlBlanks).Cells(1).Select
'Fügt kopierte Daten ein
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Formatiert eingefügte Daten
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'Sortiert gesamte Arbeitsmappe nach "Album-Titel-Interpret"
Range("A2").Select
ActiveWorkbook.Worksheets("Songliste-ABC").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Songliste-ABC").Sort.SortFields.Add2 Key:=Range( _
"A2:A25000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Songliste-ABC").Sort.SortFields.Add2 Key:=Range( _
"B2:B25000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Songliste-ABC").Sort.SortFields.Add2 Key:=Range( _
"C2:C25000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Songliste-ABC").Sort
.SetRange Range("A1:I25000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Call Anzahl_Songs_berechnen
End Sub
Sub Anzahl_Songs_berechnen()
'
' Anzahl Songs berechnen
Range("A2").Select
[A:A].SpecialCells(xlBlanks).Cells(1).Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[-14035]C:R[-1]C)"
End Sub
Ich möchte das z.B. bei foldendem Code:
Worksheets(1).Sort.SortFields.Clear
Worksheets(1).Sort.SortFields.Add2 Key _
:=Range("A2:A25000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
Das :=Range("A2:A25000") das A2:A25000 dynamisch, nach anzahl tatsächlicher belegter Zelle sprich letzte belegtre Zelle berechnet wird. Dasselbe gilt für die Formel "Anzahl2".
Danke euch schon im vorraus
Mit "Range" in Celle "A2" springen und bis zur letzten gefüllten Zelle markieren
