Zeilen in variable Tabellenblätter kopieren

[atilla]

Hallo Peggy,

in meinem Code fehlt weder End If noch ein Next.

Da musst Du schon zeigen, wie Du den bei Dir eingebaut hast.

[Peggymaus]

Hallo Attila,

du hast natürlich Recht. Habe nicht gesehen, dass Deine Nachricht noch weiter runter ging. Sorry.

Wie gesagt mein Code schaut jetzt so aus:

Code:

Private Sub CommandButton1_Click()
Dim i As Long
Dim letzteZeile
Dim strgTab As String
Application.ScreenUpdating = False
Range("P3").Select
ActiveCell.FormulaR1C1 = "=IF(AND(R[1]C[-9]="""",R[1]C[-7]<>""""),1,"""")"
   Range("P2").Select
   Selection.Copy
   Range("P3:P1000").Select
   Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
       SkipBlanks:=False, Transpose:=False
   Range("P2").Select
   Application.CutCopyMode = False
For i = 3 To 100
  If Cells(i, 16) = "1" Then   'Spalte p nach "1" prüfen
    strgTab = DateSerial(Year(Cells(i, 7)), Month(Cells(i, 7)), 1) 'wenn ein "S" dann aus dem Datum der Spalte G der Zeile das entsprechende Blatt (Zieltabelle) ermitteln
    With Sheets(strgTab)
       letzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1   'erte freie Zeile in Spalte 1 der Zieltabelle ermitteln
      .Range(.Cells(letzteZeile, 1), .Cells(letzteZeile, 15)) = Range(Cells(i, 1), Cells(i, 15)).Value 'Den Inhalt des Bereichs A:O in den in den Bereich A:O der Zieltabelle schreiben
    End With
    End If
    Next i
     ActiveSheet.Range("$A$2:$Q$1000").AutoFilter Field:=16, Criteria1:="<>"
   Rows("3:1183").Select
   Selection.Delete Shift:=xlUp
   ActiveSheet.Range("$A$2:$Q$999").AutoFilter Field:=16
   Range("L3").Select
   Application.ScreenUpdating = True
End Sub

Bräucht ihn nur so umgebaut, dass die ganze Zeile mit kompletter Formatierung kopiert wird.
Der Rest funktioniert super.

LG.

Peggy

[atilla]

Hallo,

diese Zeile:
.Range(.Cells(letzteZeile, 1), .Cells(letzteZeile, 15)) = Range(Cells(i, 1), Cells(i, 15)).Value

so ändern:

Range(Cells(i, 1), Cells(i, 15)).Copy .Cells(letzteZeile,1)

[Peggymaus]

Supi, Dankeschön... und wenn mir die Zieltabelle jetzt noch nach B aufsteigen sortiert wird, wäre es das
Sahnestückchen.

LG

Peggy

[schauan]

Hallöchen,
da hilft schon aufzeichnen
Das Makro2 ist aufgezeichnet, Makro3 daraus etwas umgeschrieben.

Code:

Sub Makro2()
'
' Makro2 Makro
'

'
    Columns("A:E").Select
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range("B1:B18" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle1").Sort
        .SetRange Range("B1:E18")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
End Sub

Sub Makro3()
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("B1:B18" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A1:E18")
        .Header = xlGuess
        .Apply
    End With
End Sub

[Peggymaus]

Hallo,

Danke für die Antwort. Sorry dass ich mich heute erst wieder melde.

Leider habe ich das mit dem aufzeichnen und umformulieren des Codes auch schon probiert. Aber Excel sortiert mir dann immer die Sperrliste und nicht
die Liste in die die Artikel hineinkopiert wurden.

Ich hoffe es hat noch jemand eine bessere Idee.

Mein Code schaut im Moment so aus, aber wie gesagt es wird die falsche Liste sortiert.

Code:

Private Sub CommandButton1_Click()
  Dim i As Long
  Dim letzteZeile
  Dim strgTab As String
  Dim Sortierspalte As String
  Dim Bereich As String
 
  Application.ScreenUpdating = False
  Range("P3").Select
  ActiveCell.FormulaR1C1 = "=IF(AND(R[1]C[-9]="""",R[1]C[-7]<>""""),1,"""")"
  Range("P2").Select
  Selection.Copy
  Range("P3:P1000").Select
  Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
  Range("P2").Select
  Application.CutCopyMode = False
  For i = 3 To 100
     If Cells(i, 16) = "1" Then   'Spalte p nach "1" prüfen
       strgTab = DateSerial(Year(Cells(i, 7)), Month(Cells(i, 7)), 1) 'wenn ein "S" dann aus dem Datum der Spalte G der Zeile das entsprechende Blatt (Zieltabelle) ermitteln
       With Sheets(strgTab)
          letzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1   'erte freie Zeile in Spalte 1 der Zieltabelle ermitteln
          Range(Cells(i, 1), Cells(i, 15)).Copy .Cells(letzteZeile, 1)
          ActiveSheet.Sort.SortFields.Clear
          ActiveSheet.Sort.SortFields.Add Key:=Range("B1:B500" _
              ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
          With ActiveSheet.Sort
             .SetRange Range("A1:o500")
             .Header = xlGuess
             .Apply
          End With
       End With
       Range("C12").Select
       Sheets("Sperrliste").Select
       Range("P4").Select
     End If
  Next i
  ActiveSheet.Range("$A$2:$Q$1000").AutoFilter Field:=16, Criteria1:="<>"
  Rows("3:1183").Select
  Selection.Delete Shift:=xlUp
  ActiveSheet.Range("$A$2:$Q$999").AutoFilter Field:=16
  Range("L3").Select
  Application.ScreenUpdating = True
End Sub

LG.

Peggy

[schauan]

Hallöchen,

der Code von Dir ist auch aufgezeichnet?

mal vor dem Sortieren was anderes. Wenn DU dne Code analysierst, ist es zuweilen Hilfreich, zu den einzelnen Zeilen Kommentare zu schreiben. Wo Du weist, was passiert, ist ok. Wo nicht, kannst Du fragen ...

Code:

'Zelle P3 auswählen
Range("P3").Select
'in aktive Zelle eine Formel eintragen. Aktiv ist in der Regel die ausgewählte Zelle
ActiveCell.FormulaR1C1 = "=IF(AND(R[1]C[-9]="""",R[1]C[-7]<>""""),1,"""")"
'Zelle P2 auswählen
Range("P2").Select
'ausgewählte Zelle kopieren
Selection.Copy
'Bereich P3 bis P1000 auswählen
Range("P3:P1000").Select
'aus P2 kopierte Formel in die Auswahl übernehmen
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

So, fällt Dir was auf?

Jetzt zum sortieren.
Mit diesem codeteil wird sortiert.

Code:

'Sortierspalte und -Eigenschaften festlegen
ActiveSheet.Sort.SortFields.Add Key:=Range("B1:B500" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
'Sortierbereich festlegen, A1:O500
.SetRange Range("A1:o500")

So, im ersten Code hast Di in Spalte P etwas eingefügt.
Jetzt sortierst Du die Spalten A bis O, also nicht den Bereich, wo Du eingefügt hast. P kommt nach O :-(
Sortierspalte ist außerdem B. Falls die Spalte P für die Sortierung relevant ist, wäre das auch verkehrt.

Falls A:O Deine Sperrliste ist und die Zielliste in Spalte P beginnt, wäre der Bereich P:Irgendwo und nicht A:O bzw. A:P

[Peggymaus]

Hallo,

das mit dem Sortieren klappt ja, aber leider wird die falsche Liste sortiert. Es soll nicht die Sperrliste neu sortiert werden,
sondern die Liste in welche der Artikel zurück kopiert wurde.

:s

LG.

Peggy

[atilla]

Hallo Peggy,

diesen Teil

Code:

      With Sheets(strgTab)
         letzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1   'erte freie Zeile in Spalte 1 der Zieltabelle ermitteln
         Range(Cells(i, 1), Cells(i, 15)).Copy .Cells(letzteZeile, 1)
         ActiveSheet.Sort.SortFields.Clear
         ActiveSheet.Sort.SortFields.Add Key:=Range("B1:B500" _
             ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
         With ActiveSheet.Sort
            .SetRange Range("A1:o500")
            .Header = xlGuess
            .Apply
         End With
      End With

so ersetzen:

Code:

      With Sheets(strgTab)
         letzteZeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1   'erte freie Zeile in Spalte 1 der Zieltabelle ermitteln
         Range(Cells(i, 1), Cells(i, 15)).Copy .Cells(letzteZeile, 1)
         .Sort.SortFields.Clear
         .Sort.SortFields.Add Key:=.Range("B1:B500" _
             ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
         .Sort.SetRange .Range("A1:o500")
         .Sort.Header = xlGuess
         .Sort.Apply
      End With

[RPP63]

@Atilla:
An Dich als VBA-Fachmann die Frage:
Welchen Vorteil hat die "neue" Sortiermethode?
Ich verwende seit Jahr und Tag die "alte", weil sie so schön kompakt ist:

Code:

Sub Sortiere()
With Tabelle3
  .Cells(1).CurrentRegion.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes
End With
End Sub

Gruß Ralf