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

• #27638 Delila_1 veterán Polllen #27637

  Új Válasz 2015-07-08 11:24:20 #27638

  Ú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 Polllen #27637 üzenetére

  Nem túl bonyolult.
  A makró elején töröltethettem volna az első lapon kívül a többit, hogy "tiszta lappal" kezdjünk, de nem ismerem a füzeted felépítését. Lehet, hogy vannak benne nem törölhető lapok.

  A makró az első lap sorain megy végig. Mikor a sorban lévő szállítólevél nevével egyező lap van a füzetben, az első üres sorába bemásolja az aktuális sort. Ha nincs olyan lap, akkor a füzet végén létrehozza, átmásolja a címsort az első lapról, majd alá az aktuális sort.

  Sub Szall_Lev()
  Dim sor As Long, usor As Long, usorIde As Long, nev
  Dim WS As Worksheet, WSIde As Worksheet
  Application.ScreenUpdating = False
  
  Set WS = Sheets(1)
  WS.Select
  usor = Range("A" & Rows.Count).End(xlUp).Row
  
  For sor = 2 To usor
  On Error Resume Next
  Set nev = Sheets(Cells(sor, "A") & "")
  If Err.Number <> 0 Then
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = WS.Cells(sor, "A")
  WS.Rows(1).Copy ActiveSheet.Range("A1")
  WS.Select
  End If
  On Error GoTo 0
  
  Set WSIde = Sheets(WS.Cells(sor, "A") & "")
  usorIde = WSIde.Range("A" & Rows.Count).End(xlUp).Row + 1
  Rows(sor).Copy WSIde.Range("A" & usorIde)
  Next
  
  Sheets(1).Activate
  Application.ScreenUpdating = True
  MsgBox "Kész", vbInformation
  End Sub

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