Excel - Sorok másolása a teljes oldalra
Probléma
Van egy Excel munkalap, 13 munkalapkal. Az első 12 munkalap január-december. A 13. munkalap összesen. Minden munkalap azonos oszlopokkal és sorokkal rendelkezik.
Minden munkalapban körülbelül 10 oszlop található, mint például a Dátum, Név, Cím, Számlaszám, Osztály, Munkavállaló neve stb.
Amit igyekszem tenni, adja meg az információkat minden havi munkalapon, és az általam bevitt adatokat automatikusan átmásolja a teljes munkalapra. A teljes munkalap tartalmazza az összes bevitt adatot. Van egy havi bontásom, de a teljes oldal tartalmazza az összes tranzakciót.
Az összes munkalap beállítása megtörtént, de nem tudok felvenni a kódot a másolás elvégzéséhez. Bármilyen javaslatot kérek?
Megoldás
Próbáld ezt. Természetesen győződjön meg róla, hogy a tesztelés előtt készítsen biztonsági másolatot az eredeti fájlról
Feltételezések.
- 1. A lapok Jan, Feb, ....
- 2. A mesterlapot Mesternek nevezzük
- 3. Az 1. oszlop nem rendelkezik üres értékkel (a sorok maximális számának megtalálásához)
- 4. Nincs több, mint 11 oszlop
- 5. A mesterlapon már van fejléc.
Sub copyData () Dim maxRows As Long Dim maxCols Mint Integer Dim conSheet Mint String 'konszolidált lap neve Dim lConRow As Long Dim maxRowCol As Integer', amellyel max. Sorok max., "Mar", "Apr", "Május", "Jun", "Jul", "Aug", "Szeptember", "Ok", "Nov", "Dec") maxRowCol = 1 conSheet = "Mester" lapok Válassza ki a tartományt ("A2"). Válassza ki a cellákat (65536, 256). Válassza ki a kiválasztást.End (xlDown) .Válassza ki a maxRows = Selection.Row Range ("A2", kiválasztás). X = 0 lapra.Count - 2 lap (hónap (x)) Válassza ki, ha az ActiveSheet.AutoFilterMode majd Cells.Select Selection.AutoFilter End Ha Cells.Select Dim lastRow As Long lastRow = cellák (maxRows, maxRowCol). xlUp) .Row If (lastRow> 1), majd Range (Cells (2, 1), Cells (lastRow, maxCols)). Select Selection.Copy Sheets (conSheet) .Select Cells (lConRow, 1). = Cellák (maxRows, maxRowCol) .End (xlUp) .Low lConRow = lSummaryRow + 1 Vége Ha az ActiveSheet.Name = "Dec "Ezután lépjen ki a Sub Next End Sub részből
jegyzet
Köszönjük a rizvisa1-nek, hogy ezt a tippet a fórumon.