-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
félisten
válasz Fire/SOUL/CD #8352 üzenetére
Hali!
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"
'Az első adat az oszlopban
My_Row = 2
'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 = 0
For i = 1 To Worksheets.Count - 1
Worksheets(i).Select
Worksheets(i).Range(My_Column & My_Row).Select
Set My_Range = Worksheets(i).Range(My_Column & My_Row & ":" & My_Column & Worksheets(i).UsedRange.Rows(Worksheets(i).UsedRange.Rows.Count).Row)
My_Range.Select
For Each CurrCell In My_Range
Worksheets(My_Sheet_Name).Range(My_Column & 1 + 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 SubFire.
[ Módosította: Ndruu ]
Mindenki tudja, hogy bizonyos dolgokat nem lehet megvalósítani, mígnem jön valaki, aki erről nem tud, és megvalósítja. (Albert Einstein)
Új hozzászólás Aktív témák
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen
Cég: Promenade Publishing House Kft.
Város: Budapest