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

• #30302 sztanozs veterán butch3r #30300

  Új Válasz 2016-01-29 15:02:57 #30302

  Ú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

  

  sztanozs

  veterán

  válasz butch3r #30300 üzenetére

  Public Sub ttt()
  Dim r1 As Range
  Set r1 = Application.Intersect(Workbooks("Book1").Sheets("Sheet1").Range("B25:D65535"), Workbooks("Book1").Sheets("Sheet1").UsedRange)
  Dim v1
  v1 = r1.Value2
  
  Dim r2 As Range
  Set r2 = Application.Intersect(Workbooks("Book2").Sheets("Sheet1").Range("B25:D65535"), Workbooks("Book2").Sheets("Sheet1").UsedRange)
  Dim v2
  v2 = r2.Value2
  
  Dim oldbound, newbound
  oldbound = UBound(v1, 1)
  newbound = oldbound + UBound(v2, 1)
  Dim v_cel()
  ReDim Preserve v_cel(1 To newbound, 1 To 3)
  Dim ix, iy
  For ix = 1 To UBound(v1, 1)
  For iy = 1 To 3
  v_cel(ix, iy) = v1(ix, iy)
  Next
  Next
  For ix = 1 To UBound(v2, 1)
  For iy = 1 To 3
  v_cel(oldbound + ix, iy) = v2(ix, iy)
  Next
  Next
  
  Dim r_cel As Range
  Dim kezdosor
  kezdosor = 10
  Set r_cel = Workbooks("Book1").Sheets("Sheet2").Range("B" & kezdosor & ":D" & kezdosor + UBound(v1, 1) - 1)
  r_cel.Value2 = v1
  End Sub

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