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

• #25107 Delila_1 veterán KERO_SAN #25105

  Új Válasz 2015-01-20 14:41:44 #25107

  Ú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 KERO_SAN #25105 üzenetére

  Két makró kell hozzá. Az első figyeli a 18. oszlop kitöltését, majd indítja a másikat, ami a másolást végzi el. A laphoz rendeléshez, és a modulba tevéshez sok leírás van itt a fórumon.
  Nem kell előre elkészíteni a 10 lapot, a makrók létrehozzák "1"-től "10"-ig névvel.

  Az alap táblázatot tartalmazó laphoz rendeld:

  Private Sub Worksheet_Change(ByVal Target As Range)
  Dim LapNev As String
  
  If IsEmpty(Target) Then Exit Sub
  If Target.Column = 18 Then
  LapNev = Cells(Target.Row, 1)
  Masolas Target.Row, LapNev
  End If
  End Sub

  Modulba helyezd:

  Sub Masolas(sor, LapNev)
  Dim a As Object, usor As Long
  Dim ElsoLap As Worksheet
  
  Set ElsoLap = Worksheets(ActiveSheet.Name)
  On Error Resume Next
  Set a = Sheets(LapNev)
  If Err.Number <> 0 Then
  Worksheets.Add.Name = LapNev
  ElsoLap.Rows(1).Copy Sheets(LapNev).Range("A1")
  End If
  On Error GoTo 0
  
  usor = Sheets(LapNev).Range("A" & Rows.Count).End(xlUp).Row + 1
  ElsoLap.Rows(sor).Copy Sheets(LapNev).Range("A" & usor)
  ElsoLap.Move Before:=Sheets(1)
  End Sub

  Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

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