kokusz19

VBA - Day1

Oct 20th, 2020 (edited)
700
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2.  
  3. Sub process()
  4.     Dim oldSheet As Worksheet
  5.     Dim newSheet As Worksheet
  6.  
  7.     Set oldSheet = Worksheets("Data")
  8.     Set newSheet = Worksheets.Add()
  9.  
  10.     Application.DisplayAlerts = False
  11.     oldSheet.Delete
  12.     Application.DisplayAlerts = True
  13.     newSheet.Name = "Data"
  14.    
  15.     Dim fso As New Scripting.fileSystemObject
  16.     Dim folder As folder
  17.     Dim mappa As String
  18.     mappa = Worksheets("Parameters").Range("folder").Value
  19.     Set folder = fso.GetFolder(mappa)
  20.    
  21.     Dim F As Scripting.File
  22.     Dim first As Boolean
  23.     first = True
  24.    
  25.     For Each F In folder.Files
  26.         If first Then
  27.         'Debug.Print F.Name 'View>ImmediateWindow
  28.            FileImport F.Path, True
  29.             first = False
  30.         Else
  31.             FileImport F.Path, False
  32.         End If
  33.     Next F
  34.    
  35.     'FileImport "C:\Users\Kokusz\Documents\ExcelVBA\SharedFiles\Excel\MonthlyData\resolveit_exp_2016-01.xlsx", True
  36.    
  37. End Sub
  38.  
  39. Sub FileImport(filePath As String, Optional copyHeader As Boolean = True)
  40.     Application.DisplayAlerts = False
  41.     'open file
  42.    'ChDir "C:\Users\Kokusz\Documents\ExcelVBA\SharedFiles\Excel\MonthlyData"
  43.    Dim Wb As Workbook
  44.     Set Wb = Workbooks.Open(Filename:=filePath)
  45.    
  46.     'selecting all data
  47.    Dim Ws As Worksheet
  48.     Set Ws = Wb.ActiveSheet
  49.     Wb.Activate 'csak active sheeten lehet kijelölni
  50.    
  51.     Dim R As Range
  52.     Set R = Ws.UsedRange
  53.     If Not copyHeader Then
  54.         Set R = R.Resize(R.Rows.Count - 1)
  55.         Set R = R.Offset(1)
  56.     End If
  57.     R.Select
  58.     Selection.Copy
  59.    
  60.     Dim lastRow As Integer
  61.    
  62.     Windows("Report.xlsm").Activate
  63.     lastRow = ActiveSheet.UsedRange.Rows.Count
  64.     If Not lastRow = 1 Then
  65.         ActiveSheet.Cells(lastRow + 1, 1).Select
  66.     Else
  67.         Range("A1").Select
  68.     End If
  69.    
  70.     ActiveSheet.Paste
  71.     Selection.PasteSpecial Paste:=xlPasteColumnWidths, _
  72.         Operation:=xlNone, skipBlanks:=False
  73.            
  74.     'Workbooks("resolveit_exp_2016-01.xlsx").Close False
  75.    'Windows("resolveit_exp_2016-01.xlsx").Activate
  76.    'ActiveWindow.Close False
  77.    Wb.Close SaveChanges:=False
  78.     Application.DisplayAlerts = True
  79. End Sub
  80.  
RAW Paste Data