The Copy method of the Range object has failed.
Herkabe
Posted messages
18
Status
Member
-
Patrice33740 Posted messages 8400 Registration date Status Member Last intervention -
Patrice33740 Posted messages 8400 Registration date Status Member Last intervention -
Bonjour,
I came here a couple of days ago for help coding my compiler, which I ultimately succeeded in doing thanks to Patrice.
However, I would like to use the compiler for all types of data shapes (i.e., regardless of the variation in the number of rows or columns).
In the initial files that I wanted to compile, there were about a hundred lines per file, for 13 columns, and 2 header rows. In the new files, there are still about a hundred lines but now there are 19 columns.
The macro, which works very well for compiling the 13-column files, suddenly doesn't work for the files that have more than 13 columns (I haven't tested for fewer yet).
Here is the code:
For both types of files, it is necessary to copy starting from line 5, but I have tested for all columns with the constant col, and nothing works!
Here are images of the files to give you an idea:
My question: What needs to be changed in the code to easily adapt it to any type of files (the error is located at the line rng.Copy dst)?
I came here a couple of days ago for help coding my compiler, which I ultimately succeeded in doing thanks to Patrice.
However, I would like to use the compiler for all types of data shapes (i.e., regardless of the variation in the number of rows or columns).
In the initial files that I wanted to compile, there were about a hundred lines per file, for 13 columns, and 2 header rows. In the new files, there are still about a hundred lines but now there are 19 columns.
The macro, which works very well for compiling the 13-column files, suddenly doesn't work for the files that have more than 13 columns (I haven't tested for fewer yet).
Here is the code:
Option Explicit
Sub TEST2()
Dim fso As Object 'File system
Dim rep As Object 'Folder
Dim cfr As Object 'Collection of files in the folder
Dim fic As Object 'File (element of the cfr collection)
Dim wbk As Workbook 'Workbook
Dim res As Workbook 'Result workbook
Dim rng As Range 'Range of cells
Dim dst As Range 'Destination cell
Dim pth As String 'Path of the folder
Dim etc As Boolean 'Header copied
Const lig$ = "5" 'Address of the first row of tables to copy
Const col$ = "F" 'Address of the column to test
' Define the folder to read
pth = "C:\Users\vdesigau\Desktop\Reporting WC\BA"
' Create the result file
Set res = Workbooks.Add(xlWBATWorksheet)
Set dst = res.Worksheets(1).Range("A1")
' Read the folder
Set fso = CreateObject("Scripting.FileSystemObject")
Set rep = fso.GetFolder(pth)
Set cfr = rep.Files
' Control each file in the folder
For Each fic In cfr
' - Check if it is an Excel file...
If StrComp(fso.GetExtensionName(fic.Name), "xls", vbTextCompare) = 0 Then
' ... if so, open the file and update the links
Set wbk = Workbooks.Open(Filename:=pth & "\" & fic.Name, UpdateLinks:=xlUpdateLinksAlways)
' Define the rows to copy
With wbk.Worksheets(1)
Set rng = .Rows(lig & ":" & .Cells(.Rows.Count, col).End(xlUp).Row)
End With
' If the header is already copied ....
If etc Then
' ... reduce the rows to the data without header
Set rng = rng.Offset(3).Resize(rng.Rows.Count - 3)
End If
' Copy entire rows
rng.Copy dst
' Header copied
etc = True
' Next destination
Set dst = dst.Offset(rng.Rows.Count)
' Close the file without saving
wbk.Close False
End If
Next fic
End Sub
For both types of files, it is necessary to copy starting from line 5, but I have tested for all columns with the constant col, and nothing works!
Here are images of the files to give you an idea:
My question: What needs to be changed in the code to easily adapt it to any type of files (the error is located at the line rng.Copy dst)?
2 answers
-
Re,
The macro does not depend on the number of columns as it copies entire rows!
The constants for row and column need to be adjusted:
row is the first row of the table headers, so it is = 1 in the second case.
column is the one used to determine the number of rows to copy, = "F" seems to be the right one.
Furthermore, your new tables have 5 header rows (instead of 3), so you need to replaceSet rng = rng.Offset(3).Resize(rng.Rows.Count - 3)
withSet rng = rng.Offset(5).Resize(rng.Rows.Count - 5)
--
Best regards
Patrice-
Here is the translation of the provided VBA code description into English: ```html
Option Explicit Sub Combine_Files() Dim fso As Object 'File system Dim rep As Object 'Folder Dim cfr As Object 'Collection of files in the folder Dim fic As Object 'File (element of the cfr collection) Dim wbk As Workbook 'Workbook Dim res As Workbook 'Result workbook Dim rng As Range 'Range of cells Dim dst As Range 'Destination cell Dim pth As String 'Folder path Dim etc As Boolean 'Header copied Const lig$ = "1" 'Address of the first row of tables to copy Const col$ = "F" 'Address of the column to test Const nlt& = 5 'Number of header rows to copy (only once) ' Define the folder to read pth = ThisWorkbook.Path & "\tmp" ' Create the result file Set res = Workbooks.Add(xlWBATWorksheet) Set dst = res.Worksheets(1).Range("A1") ' Read the folder Set fso = CreateObject("Scripting.FileSystemObject") Set rep = fso.GetFolder(pth) Set cfr = rep.Files ' Control each file in the folder For Each fic In cfr ' - Check if it is an Excel file... If StrComp(fso.GetExtensionName(fic.Name), "xls", vbTextCompare) = 0 Then ' ... if yes, open the file and update links Set wbk = Workbooks.Open(Filename:=pth & "\" & fic.Name, UpdateLinks:=xlUpdateLinksAlways) ' Define the rows to copy With wbk.Worksheets(1) Set rng = .Rows(lig & ":" & .Cells(.Rows.Count, col).End(xlUp).Row) End With ' If the header is already copied .... If etc Then ' ... reduce the rows to the data without header Set rng = rng.Offset(nlt).Resize(rng.Rows.Count - nlt) End If ' Copy the entire rows rng.Copy dst ' Header copied etc = True ' Next destination Set dst = dst.Offset(rng.Rows.Count) ' Close the file without making changes wbk.Close False End If Next fic End Sub```
-
-
Hello Patrice, and thank you for your great responsiveness.
After applying the changes you mentioned, I encountered a 1004 error: defined by the application or by the object, for the lineSet rng = rng.Offset(5).Resize(rng.Rows.Count - 5)
