Advertisement
Illustria

Test

Apr 21st, 2023
434
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub OpenAndCopyColumns()
  2.     Dim folderPath As String
  3.     Dim fileName As String
  4.     Dim sourceWorkbook As Workbook
  5.     Dim destWorkbook As Workbook
  6.     Dim sourceWorksheet As Worksheet
  7.     Dim destWorksheet As Worksheet
  8.     Dim i As Integer
  9.    
  10.     ' Set folder path and destination workbook/worksheet
  11.    folderPath = "C:\YourFolderPath\" ' Change this to the folder containing the files
  12.    Set destWorkbook = ThisWorkbook
  13.     Set destWorksheet = destWorkbook.Worksheets("Sheet1") ' Change this to the destination worksheet
  14.    
  15.     ' Loop through 6 files in the folder
  16.    fileName = Dir(folderPath & "*.xlsx") ' Change the file extension if needed
  17.    i = 1
  18.     Do While fileName <> "" And i <= 6
  19.         ' Open source workbook and set source worksheet
  20.        Set sourceWorkbook = Workbooks.Open(folderPath & fileName)
  21.         Set sourceWorksheet = sourceWorkbook.Worksheets(1) ' Change this to the source worksheet
  22.        
  23.         ' Call the CopyColumnsByHeaders function to copy columns
  24.        Call CopyColumnsByHeaders(sourceWorkbook, sourceWorksheet, destWorkbook, destWorksheet, 1, "Header1", "Header2", "Header3") ' Change the header names as needed
  25.        
  26.         ' Close the source workbook
  27.        sourceWorkbook.Close SaveChanges:=False
  28.        
  29.         ' Move to the next file
  30.        fileName = Dir
  31.         i = i + 1
  32.     Loop
  33. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement