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

• #28660 szőröscica addikt

  Új Válasz 2015-09-16 18:19:52 #28660

  Ú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

  

  szőröscica

  addikt

  Sziasztok!

  Van egy makróm, amit arra használok, hogy egy mappában szereplő összes xls tartalmát behúzza egyetlen sheetre. Először egy másik makróval kilistáztatom az összes fájlt ami az adott mappában van, majd futtatom az alul találhatót.

  Tudnátok segíteni abban, hogy hogyan tudnám módosítani olyan módon, hogy miután egy fájlból bemásolta az összes sort, törölje ki azokat a sorokat, amiknek bármelyik (vagy ha így nem lehet, akkor I és M oszlopban) cellájában q vagy r szerepel.

  Azért lenne erre szükségem, mert 16-17 ezer sorosak a fájlok, amiket importál a makró, viszont mindegyiknek körülbelül harmadában szerepel q vagy r érték, amelyek számomra haszontalan adatok, így rengeteg helyet spórolhatnak (közel vagyok az 1 millió sorhoz, és ha azt túllépem, nem másolja tovább a makró dolgokat).

  Az alábbi makrót használom az importálásra. Segítenétek módosítani?

  Köszönöm szépen.

  Sub pasteall()
  
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  Dim PL, files As Variant
  Dim i, j As Long
  Dim k, l, m, n As Long
  Dim wbname As String
  
  
  
  ' select this workbook and clear all the input sheets
  
  wbname = ThisWorkbook.Name
  
  Workbooks(wbname).Activate
  Sheets("Data Sheet").Activate
  Range("D4:U1000000").ClearContents
  
  
  'copy data
  
  For i = 1 To Range("WorkbookCount").Value
  
  workbookpath = Range("Workbook_Name_Header").Offset(i, 0)
  PL = Range("Desk_Name_Header").Offset(i, 0)
  files = Range("File_Name").Offset(i, 0)
  
  
  
  
  Workbooks.Open (workbookpath)
  
  Sheets("Data").Activate
  Range("A65000").Select
  Selection.End(xlUp).Select
  
  l = Selection.Row
  Range("A2:W" & l).Select
  Selection.Copy
  
  
  Workbooks(wbname).Activate
  Sheets("Data Sheet").Activate
  Range("A1035000").Select
  Selection.End(xlUp).Select
  
  Selection.Offset(1, 0).Select
  Selection.PasteSpecial Paste:=xlPasteValues
  Application.CutCopyMode = False
  
  Workbooks(files).Activate
  ActiveWorkbook.Close
  
  
  Next i
  
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  
  
  End Sub

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