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

• #31029 Fferi50 Topikgazda Simba86 #31027

  Új Válasz 2016-03-16 07:49:39 #31029

  Ú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

  

  Fferi50

  Topikgazda

  válasz Simba86 #31027 üzenetére

  Szia!

  Az Adatok - Speciális szűrővel egyből a másik helyre másolhatod a szűrt adatokat. Az a fontos, hogy arról a munkalapról indítsd, ahová másolni szeretnéd az adatokat. A párbeszéd ablakot értelemszerűen töltsd ki.
  Ha makrórögzítővel felveszed, akkor csak a szűrőtartomány megfelelő értékeit kell változtanod, mielőtt elindítod a makrót.

  Üdv.

• #31028 Delila_1 veterán Simba86 #31027

  Új Válasz 2016-03-16 07:36:54 #31028

  Ú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 Simba86 #31027 üzenetére

  Az eredeti, ömlesztett adatokat tartalmazó lapnak az Eredeti nevet adtam. A csillagokkal jelzett sorban írd át a nevét.

  A makró végig megy az Eredeti lap sorain. Megnézi, van-e a sorban szereplő ÁFA-kód nevű lap. Ha nincs, létrehozza. Az aktuális sor adatait átmásolja a megfelelő lapra.

  Sub Szortirozas()
  Dim sor As Long, usor As Long, kod, lapnev
  
  With Sheets("Eredeti") '*****
  sor = 2
  Do While .Cells(sor, "C") <> ""
  kod = .Cells(sor, "C") & ""
  On Error Resume Next
  Set lapnev = Sheets(kod)
  If Err.Number <> 0 Then
  Sheets.Add Before:=Sheets(Sheets.Count)
  ActiveSheet.Name = kod
  .Rows(1).Copy Sheets(kod).Range("A1")
  .Rows(sor).Copy Sheets(kod).Range("A2")
  On Error GoTo 0
  Else
  usor = Application.WorksheetFunction.CountA(Sheets(kod).Columns(3)) + 1
  .Rows(sor).Copy Sheets(kod).Range("A" & usor)
  End If
  
  sor = sor + 1
  Loop
  End With
  Beep
  MsgBox "Kész van.", vbInformation
  End Sub

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