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

• #17331 whatnot őstag baderoli #17319

  Új Válasz 2013-03-19 16:08:04 #17331

  Ú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

  

  whatnot

  őstag

  válasz baderoli #17319 üzenetére

  Hát pedig az eredeti problémádra írtam egy makrót, rejtegetések nélkül.

  Book2-be másol Book1-ból.
  Adatok A1-től lefelé vannak, csak a cellákat másolja, nem sorokat.
  Ha sorokat is kéne másolni, akkor nyilván azzal ki kell egészíteni.

  *Hm, az utolsó cellát még egyszer bemásolja lejjebb, megnézem, miért
  Ok, megvan, egy felesleges ciklus volt.

  Sub Copy30()
  
  Application.ScreenUpdating = False
  
  Dim LastRow As Integer
  Dim cycle As Integer
  Dim i As Integer, j As Integer, k As Integer
  
  LastRow = Workbooks("Book1").Sheets("Sheet1").Range("A1").End(xlDown).Row
  
  cycle = LastRow \ 30
  
  For i = 0 To cycle
  j = i * 35 + 1
  k = i * 30 + 1
  If i <> cycle Then
  Workbooks("Book1").Sheets("Sheet1").Activate
  Range(Cells(k, 1), Cells(k + 29, 1)).Select
  Selection.Copy
  Workbooks("Book2").Sheets("Sheet1").Activate
  Range(Cells(j, 1), Cells(j, 1)).Select
  Selection.PasteSpecial
  Else
  Workbooks("Book1").Sheets("Sheet1").Activate
  Range(Cells(k, 1), Cells(LastRow, 1)).Select
  Selection.Copy
  Workbooks("Book2").Sheets("Sheet1").Activate
  Range(Cells(j, 1), Cells(j, 1)).Select
  Selection.PasteSpecial
  End If
  Next
  
  Range("A1").Activate
  
  End Sub

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