VBA: Kopieren und letzte Zeile in der aktuellen Region

Question

Mein Ziel einfügen:
Kopie letzte Zeile in jedem aktuellen Bereich und in A26 Region einfügen.
Also wäre A26 die erste Zelle in dieser neuen Region.
Auch Zelleninhalte wechseln.
Hinweis, dass der Inhalt in Zelle A = C-Zelle in dem neuen Bereich,
B-> E, C-> B, D-> D, E> A.
Erwartete Ergebnisse finden Sie im Bild unten.

Problem im aktuellen code:
Ich war mir nicht sicher, wie man alle Zellen kopiert und sie in entsprechende Spalte einfügt.
Statt jeweils nur letzte Zeile immer hervorgehoben,
einige der aktuellen Region bekam letzte 2 Zeilen hervorgehoben.
Auch der aktuelle Code, nur die letzte Zeile im Blatt kopieren, wie es in der Schleife überschrieben wurde?

Dim ws As Worksheets 
Dim rng As Range 
Dim r As Long 
Dim wb As Workbook 

Set wb = ThisWorkbook 
For Each ws In wb.Worksheets   
    If ws.Name = "Master" Then 
    For Each rng In ws.UsedRange.SpecialCells(xlCellTypeConstants, 3).Areas 
      r = rng.Cells(rng.Rows.Count, 1).Row 'last row 
     Set rng = ws.Range(Cells(r, "A"), Cells(r, "J")) 'range = last row cells from col A-J 
     rng.Interior.ColorIndex = 3 'highlight that range 
     rng.Copy 
     ws.Range("A26").PasteSpecial xlPasteValues 'paste them all to same sheet A26 
    Next rng 
    End If 
Next ws 
End Sub 

Ich bin zu vba noch neu. Kann mir jemand etwas Licht geben?

Answer 1

rng.Copy 
ws.Range("A26").PasteSpecial xlPasteValues 'paste them all to same sheet A26 

Ihr Code überschreibt immer die gleiche Zeile. Um dies zu vermeiden Sie die oben genannten Aussagen in

Dim pasteRow As Long 
pasteRow = ws.Cells(ws.Rows.count, 1).End(xlUp).row + 1 
If pasteRow < 26 Then pasteRow = 26 
ws.Cells(pasteRow, "A").Resize(,rng.Columns.Count).Value = rng.Value 

B-> E ändern können, C-> B, D-> D, E-> A

wechseln Zellen beim Kopieren, Sie spielen, um oberhalb der letzten Zeile zu ersetzen, dh

ws.Cells(pasteRow, "E").Value = rng.Cells(1, "B").Value 
ws.Cells(pasteRow, "B").Value = rng.Cells(1, "C").Value 
ws.Cells(pasteRow, "D").Value = rng.Cells(1, "D").Value 
ws.Cells(pasteRow, "A").Value = rng.Cells(1, "A").Value 

Statt nur jeweils letzte Zeile des Erhaltens hervorgehoben

ich keinen Grund dafür, außer es gab tatsächlich zwei Bereiche, aus einem unbekannten Grund finden konnte.