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

• Delila_1 veterán

  #35997

  #35996 PerezT

  2017-08-19 14:03:51

  Új Válasz

  Ú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

  

  Delila_1

  veterán

  #35996 PerezT

  3 helyen, a csillagozott sorokban kell módosítanod a makrót.
  Nálam Munka1 a kiinduló lap neve, és Munka2, ahova átrendezve bemásolja az értékeket.

  A sorIde = 1: oszlopIde = 1 változók értékei adják meg, hogy a 2. lapon hol kezdődjön a tábla, ami itt az A1-es cella sora, és oszlopa.

  Sub transz()
Dim sor As Long, usor As Long, sorIde As Long
Dim oszlop As Integer, uoszlop As Integer, oszlopIde As Integer

Sheets("Munka1").Select '***
uoszlop = Cells(1, Columns.Count).End(xlToLeft).Column
usor = Range("A" & Rows.Count).End(xlUp).Row
sorIde = 1: oszlopIde = 1 '***

With Sheets("Munka2") '***
For oszlop = 2 To uoszlop
For sor = 2 To usor
.Cells(sorIde, oszlopIde) = Cells(1, oszlop)
If Cells(sor, oszlop) > "" Then
.Cells(sorIde, oszlopIde + 1) = Cells(sor, 1)
.Cells(sorIde, oszlopIde + 2) = Cells(sor, oszlop)
sorIde = sorIde + 1
End If
Next
Next
End With
End Sub

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