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

• #15846 poffsoft veterán dellfanboy #15844

  Új Válasz 2012-12-18 14:04:36 #15846

  Ú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

  

  poffsoft

  veterán

  válasz dellfanboy #15844 üzenetére

  És a KM állás sorában nincsen olyan cella, ami azonosítja, hogy ez a km állás sora lesz? mert azt akár fv-nyel is megoldhatnánk...

  makróval simán átmásolható:
  Option Explicit
  
  Sub CopyRows()
  
  Dim i As Integer
  Dim r1, c1, r2, c2, r3 As Double
  Dim wsTest As Worksheet
  Dim sname As String
  sname = "Summa"
  Set wsTest = Nothing
  On Error Resume Next
  Set wsTest = Worksheets(sname)
  On Error GoTo 0
  
  If wsTest Is Nothing Then
  Worksheets.Add(Before:=Sheets(1), Count:=1, Type:=xlWorksheet).Name = sname
  End If
  
  Worksheets(sname).Cells.Clear
  
  For i = 1 To Sheets.Count
  If Not Worksheets(i).Name = sname Then
  r1 = Worksheets(i).UsedRange.Row
  c1 = Worksheets(i).UsedRange.Column
  r2 = r1 + Worksheets(i).UsedRange.Rows.Count - 1
  c2 = c1 + Worksheets(i).UsedRange.Columns.Count - 1
  r3 = Worksheets(sname).UsedRange.Row + Worksheets(sname).UsedRange.Rows.Count
  Worksheets(i).Select
  Worksheets(i).Range(Cells(r1, c1), Cells(r2, c2)).Copy _
  Destination:=Worksheets(sname).Cells(r3, c1)
  End If
  Next i
  Worksheets(sname).Select
  [A1].Select
  End Sub

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