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

• #42881 Delila_1 veterán Sesy #42875

  Új Válasz 2020-01-28 08:23:50 #42881

  Ú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

  

  Delila_1

  veterán

  válasz Sesy #42875 üzenetére

  Fferi gyorsabb volt, de azért én is beteszem a saját makrómat.

  Sub Szetvalogatas()
Dim sor As Long, lapnev As String, usor As Long, a

usor = Range("A" & Rows.Count).End(xlUp).Row

For sor = 2 To usor
lapnev = Right(Cells(sor, 1), Len(Cells(sor, 1)) - 3)
On Error Resume Next
Set a = Sheets(lapnev)
If Err.Number > 0 Then
Sheets.Add.Name = lapnev
Sheets(lapnev).Move After:=Sheets.Count
End If
Sheets(lapnev).Cells(sor, 2) = Sheets("Munka2").Cells(sor, 2)
Sheets("Munka2").Select
Next
Sheets("Munka2").Move After:=Sheets(1)
MsgBox "Kész a szétválogatás", vbInformation
End Sub

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