Combine Multiple Workbooks but dont wrap my text

[Alfajr]

I'm currently stuck with a macro issue due to text wrapping and string length allowance. I'm combining 95 excel workbooks each with about 1,500 records into 1 masterfile. There are a few columns that have long text strings in them and I often get (error 1004 - max allowable characters is 911) so I take those failing files out of my source folder and keep running till it works. Second, my destination excel file wraps all those text fields and makes so many of my destination file rows 3 feet long.

How can I a. Keep my source formatting and b. Somehow workaround the few files which had a record or two with more than 911 characters in a cell and just bring them over just like a good old fashioned Copy and Paste. If you can fix this, you will be the greatest superhero that ever lived...My code is below

Sub MergeAllWorkbooks()
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    Dim LastRow As Long
  
    ' Create a new workbook and set a variable to the first sheet.
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
  
    ' Modify this folder path to point to the files you want to use.
    FolderPath = "H:\Test Data Folder\January\"
  
    ' NRow keeps track of where to insert new rows in the destination workbook.
    NRow = 1
  
    ' Call Dir the first time, pointing it to all Excel files in the folder path.
    FileName = Dir(FolderPath & "*.xlsx*")
  
    ' Loop until Dir returns an empty string.
    Do While FileName <> ""
        ' Open a workbook in the folder
        Set WorkBk = Workbooks.Open(FolderPath & FileName)
      
        LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
                 After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
                 SearchDirection:=xlPrevious, _
                 LookIn:=xlFormulas, _
                 SearchOrder:=xlByRows).Row
    Set SourceRange = WorkBk.Worksheets(1).Range("A3:CE" & LastRow)
      
        ' Set the destination range to start at column A and
        ' be the same size as the source range.
        Set DestRange = SummarySheet.Range("A" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
           SourceRange.Columns.Count)
          
        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value
      
        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count
        ' Close the source workbook without saving changes.
        WorkBk.Close savechanges:=False
      
        ' Use Dir to get the next file name.
        FileName = Dir()
    Loop
  
End Sub

 

[Debraj]

Hi @Alfajr !

Welcome to the forum..
Can you please try this code.. lil bit modification on yours code ..

Sub MergeAllWorkbooks()
  Dim SummarySheet As Worksheet
  Dim FolderPath As String
  Dim NRow As Long
  Dim FileName As String
  Dim WorkBk As Workbook
  Dim SourceRange As Range
  Dim DestRange As Range
  Dim LastRow As Long
  ' Create a new workbook and set a variable to the first sheet.
  Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
  ' Modify this folder path to point to the files you want to use.
  FolderPath = "H:\Test Data Folder\January\"
  ' NRow keeps track of where to insert new rows in the destination workbook.
  NRow = 1
  ' Call Dir the first time, pointing it to all Excel files in the folder path.
  FileName = Dir(FolderPath & "*.xlsx*")
  ' Loop until Dir returns an empty string.
  Do While FileName <> ""
  ' Open a workbook in the folder
  Set WorkBk = Workbooks.Open(FolderPath & FileName)
   
  LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
  After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
  SearchDirection:=xlPrevious, _
  LookIn:=xlFormulas, _
  SearchOrder:=xlByRows).Row
  Set SourceRange = WorkBk.Worksheets(1).Range("A3:CE" & LastRow)
   
  ' Set the destination range to start at column A and
  ' be the same size as the source range.
  Set DestRange = SummarySheet.Range("A" & NRow)
  Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
  SourceRange.Columns.Count)
   
  ' Copy over the values from the source to the destination.
  '----
  SourceRange.Copy DestRange
  '----
  ' Increase NRow so that we know where to copy data next.
  NRow = NRow + DestRange.Rows.Count
  ' Close the source workbook without saving changes.
  WorkBk.Close savechanges:=False
   
  ' Use Dir to get the next file name.
  FileName = Dir()
  Loop
  '----
 Cells.WrapText = False
  '----
End Sub

 

[Alfajr]

Hi Debraj, thank you so much for solving my issue. Using your script not only fixed my text wrapping, it also fixed the issue with my text field where it kept giving me Error 1004 (exceed limit).

I really appreciate it.

 

[Abhijeet]

Hi Debraj can tell me how to all excel file mearge in one excel sheet with File name & sheet name in front of that data

 

[Debraj]

Hi abhijeet..

* 1st please start your own thread..
* 2nd.. Please provide sample location/file/no of sheet of any other variance which need to cover, with sample expected output.
* 3rd.. before that .. please try to search in the top left search box, this query has been cover a lot of time..

you already have a lot of warning point and no of post.. please keep maintain.. otherwise we may have to banned your account..