Új hozzászólás Aktív témák

• #26102 Louro őstag bara17 #26097

  Új Válasz 2015-03-19 22:06:13 #26102

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Louro

  őstag

  válasz bara17 #26097 üzenetére

  Akkor egy segédmunkalapon felírnám a munkalapokat egymás alá. X-et tetetnék, amibe kell másolni. Majd szűrő az X-re, a megmaradt neveket tömbbe gyűjteném majd ciklussal a megfelelő munkalapokra másolnám. Ne bonyolítsuk, hogy munkalaponként máshová

  Szűréshez kulcssszó:autofilter
  ...

  Szanaszét kommentelten. Fáradtan ez lett.....valószínűleg a topiktulaj tud majd szebbet is.

  Sub Munkalapozó()
  
  Dim MunkalapTomb As Variant
  Dim WS As String
  Dim lastrow As Integer
  
  'Segéd sheet-en a munkalapok nevei. x-szel kell jelölni, hogy mi kell
  Sheets("Segéd").Range("A1:B200").AutoFilter Field:=2, Criteria1:="x"
  Range("A2:A" & ActiveSheet.UsedRange.Rows.Count).SpecialCells(xlCellTypeVisible).Select
  'mennyi munkalapról van szó. Mekkora lesz a tömb
  lastrow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count
  'másolás
  Selection.Copy
  'beillesztés egy segédoszlopba
  Range("E1").PasteSpecial xlPasteValues
  'tömbbe másolás
  MunkalapTomb = Sheets("Segéd").Range("E1:E" & lastrow).Value
  'segédoszlop törlése
  Range("E1:E" & lastrow).Clear
  'ciklus amekkora a tömb mérete
  For i = 1 To UBound(MunkalapTomb)
  'vegye ki a tömb soron következő elemét
  WS = MunkalapTomb(i, 1)
  'itt kell megadni, hogy mit akarsz másolni
  Sheets("Segéd").Range("A1:A10").Select
  'vágólapra tegye ki
  Selection.Copy
  'a megfelelő munkalapra illessze be az A1-től.
  Sheets(WS).Range("A1").PasteSpecial xlPasteValues
  Next
  
  'Szűrő kikapcsolása
  Sheets("Segéd").AutoFilterMode = False
  
  
  
  End Sub

  [ Szerkesztve ]

  Mess with the best / Die like the rest

Új hozzászólás Aktív témák