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

• #23725 slashing senior tag

  Új Válasz 2014-10-15 10:48:30 #23725

  Ú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

  

  slashing

  senior tag

  Köszi, nekem most van egy verzióm ami manuálisan félig kész már csak valahogy ciklusba kellene raknom amit még egyenlőre nem tudom hogyan kell.

  Ez most ott tart hogy a keresendo =cells(1,1) itt adom meg neki hogy melyik fejlécet keresse, kijelöli most még csak így manuálisan az Fejléc alatti adatokat(A2 xldown) és másolja, megnyitja a célfájlt, megállapítja az utolsó sort és azonosítja az oszlopot amiben szerepel a cells(1,1) fejléc majd odaugrik annak az oszlopnak az utolsó sorábá és bemásolja az adatokat.

  Nah ezt kéne ciklusba rakni valahogy úgy hogy ha berakta az első oszlop adatait visszaugrik kimásolja a B1 alatti adatokat, berakja az afölötti fejléces oszloppal rendelkező oszlopba megint visszaugrik kimásolja a C1 alattit azt is bemásolja a megfelelő fejléccel ellátott oszlopba majd ha már nem talál adatot kilépjen.

  Sub akarmdi()
  Dim LastRow As Long
  keresendo = Cells(1, 1)
  Range("A2").Select
  Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(ActiveCell.End(xlDown).Row, ActiveCell.Column)).Select
  Selection.Copy
  Pathname = "q:\SPC 2010-2012-2013\Bosch\"
  Filename = "0000-0000.xlsx"
  Workbooks.Open Filename:=Pathname & Filename
  LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  LastRow = LastRow + 1
  oszlopazonositas = Application.Match(keresendo, Workbooks("0000-0000.xlsx").Worksheets("munka1").[1:1], 0)
  ActiveSheet.Cells(LastRow, oszlopazonositas).Select
  Selection.PasteSpecial Paste:=xlPasteValues
  
  End Sub

  (#23724) Delila_1 Próbálom

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