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

• #32265 Lasersailing senior tag Lasersailing #32264

  Új Válasz 2016-08-08 09:43:13 #32265

  Ú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

  

  Lasersailing

  senior tag

  válasz Lasersailing #32264 üzenetére

  Na szóval a végleges (A vastagonszedést programkód közben nem igazán értelmezte, ami így utólag érthető... Elnézést!):

  Sub redharlow()

Dim sor As Integer
Dim oszlop As Integer
Dim ujsor As Integer
Dim sn As String


'program
sor = 1
sn = ActiveSheet.Name
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "eredmeny"
ujsor = 1
'fejlécet
Sheets("eredmeny").Cells(1, 1) = "Név"
Sheets("eredmeny").Cells(1, 2) = "C oszlop"
Sheets("eredmeny").Cells(1, 3) = "D oszlop"
Sheets("eredmeny").Cells(1, 4) = "E oszlop"
Sheets("eredmeny").Cells(1, 5) = "Dátum"
Sheets("eredmeny").Cells(1, 6) = "Ft"


Do
sor = sor + 1
For oszlop = 7 To 66
If Not (IsEmpty(Sheets(sn).Cells(sor, oszlop))) Then
ujsor = ujsor + 1
Sheets("eredmeny").Cells(ujsor, 1) = Sheets(sn).Cells(sor, 2)
Sheets("eredmeny").Cells(ujsor, 2) = Sheets(sn).Cells(sor, 3)
Sheets("eredmeny").Cells(ujsor, 3) = Sheets(sn).Cells(sor, 4)
Sheets("eredmeny").Cells(ujsor, 4) = Sheets(sn).Cells(sor, 5)
Sheets("eredmeny").Cells(ujsor, 5) = Sheets(sn).Cells(1, oszlop)
Sheets("eredmeny").Cells(ujsor, 6) = Sheets(sn).Cells(sor, oszlop)
End If
Next oszlop
Loop Until IsEmpty(Sheets(sn).Cells(sor, 1))


End Sub

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