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

• #13678 Delila_1 Topikgazda Bocimaster #13675

  Új Válasz 2012-05-10 20:35:52 #13678

  Ú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

  Topikgazda

  válasz Bocimaster #13675 üzenetére

  Sub Korhaz()
  Dim sor As Double, usor As Double, nev$
  Dim WB As Workbook
  Dim utvonal$, lap%
  
  Application.ScreenUpdating = False
  
  utvonal = "E:\Eadat\" 'itt írd be a saját útvonaladat ehelyett, ügyelj a \ jelekre
  Set WB = Workbooks("Gyerek és subspec ágyak végl.xlsm")
  usor = Cells(Rows.Count, "A").End(xlUp).Row
  
  For sor = 4 To usor
  nev$ = Cells(sor, 4) & ".xlsx" 'D oszlopban lévő név a nev$ változóba
  
  Workbooks.Add 'az új füzetet el is mentjük
  ActiveWorkbook.SaveAs Filename:=utvonal & nev$, FileFormat:= _
  xlOpenXMLWorkbook, CreateBackup:=False
  
  WB.Sheets(1).Range("1:3").Copy Range("A1") '1:3 sor másolása
  WB.Sheets(1).Rows(sor).Copy Range("A4") 'sor-adik sor másolása
  
  'újabb mentés a bemásolt adatokkal
  ActiveWorkbook.SaveAs Filename:=utvonal & nev$, FileFormat:= _
  xlOpenXMLWorkbook, CreateBackup:=False
  
  ActiveWindow.Close 'füzet bezárása
  Next
  
  Application.ScreenUpdating = True
  End Sub

  Az "A D oszlopban az intézeteket egyesével kimásolni minden egyes intézet külön fájlba és az intézet névvel elmentve.." nem egészen világos nekem. Arra gondoltál, hogy az egyes intézetek teljes sorát kell másolni? Úgy írtam meg a makrót.

  A makró bemásolása után makróbarátként kell mentened a füzetet, a kiterjesztése xlsm lesz. Ez szerepel a Set kezdetű sorban.

  [ Szerkesztve ]

  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