Ú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

  [ Szerkesztve ]

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