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

• #8350 Fire/SOUL/CD félisten Charlie Gordon #8349

  Új Válasz 2010-10-01 21:03:14 #8350

  Ú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

  

  Fire/SOUL/CD

  félisten

  válasz Charlie Gordon #8349 üzenetére

  Hali!

  Oksa, akkor

  1. Készíts másolatot az excel fájlról, biztos ami biztos
  2. Nyisd meg és az első munkalapra tegyél egy CommandButtont
  3. Kattints rá duplán, a megjelenő ablakban törölj mindent és illeszd be az alábbi kódot

  Private Sub CommandButton1_Click()
  
  Dim My_Sheet As Worksheet
  Dim My_Sheet_Name As String
  Dim My_Range As Range
  Dim My_Column As String
  
  'Oszlop, amelyikben szállítólevélszámok vannak
  '(Ugyanebben az oszlopban lesznek majd, az új munkalapon is)
  My_Column = "D"
  'A létrehozandó, összesítő munkalap neve
  My_Sheet_Name = "FSCD_Összesítés"
  
  Application.DisplayAlerts = False
  
  On Error Resume Next
  Set My_Sheet = Sheets(My_Sheet_Name)
  On Error GoTo 0
  If Not My_Sheet Is Nothing Then
  My_Sheet.Delete
  End If
  
  Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = My_Sheet_Name
  k = 1
  For i = 1 To Worksheets.Count - 1
  Worksheets(i).Select
  Worksheets(i).Range(My_Column & "1").Select
  Set My_Range = Worksheets(i).Range(My_Column & "1:" & My_Column & Worksheets(i).UsedRange.Rows.Count)
  My_Range.Select
  For Each CurrCell In My_Range
  Worksheets(My_Sheet_Name).Range(My_Column & k) = CurrCell.Value
  k = k + 1
  Next CurrCell
  Set My_Range = Nothing
  Next i
  
  Worksheets(My_Sheet_Name).Select
  
  Set My_Sheet = Nothing
  
  Application.DisplayAlerts = True
  
  End Sub

  4. kattints a CommandButtonra

  Ez a makró létrehoz a munkalapok legvégén egy új munkalapot, abba másolja az adatokat.

  Fire.

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