I'm writing a macro that opens an Excel file (.xlsx) with 6300 rows and 73 columns (the rows number is not always the same because this file is a report) and copies some columns (choosen by the user and stored in an array called stringArray) in the second sheet of the current .xlsm workbook (the workbook where I'm running the macro). The code works almost as expected if I make an assegnment using .Value but without the column formatting of the source file (colored columns and borders).
If I use the .copy method without .Value Excel locks and I have to terminate it from task manager.
stringArray is an array populated with the content of a cell and contains "D, E, G, F, K, L, M, Q, R, S, U, V, W, X, Z, AD, AE, AF, AH, AJ, AK, AL, AM, AW, AX"
What am I doing wrong?
Thanks
SOLVED:
the problem was a useless declaration of a new excel instance: Dim app As New Excel.Application
Dim SrcColsRange As String
Dim DestColsRange As String
Dim Col_char1 As String
Dim app As New Excel.Application
app.Visible = False
Set srcWorkbook = app.Workbooks.Open(FileNameSrc)
L = LBound(stringArray)
U = UBound(stringArray)
ThisWorkbook.Worksheets(2).Cells.Clear
For x = L To U
''''''''' Col_Letter RETURNS THE COLUMN LETTER FROM 1 (x+1) TO n (NUMBER OF COLUMNS PRESENT IN stringArray)
Col_char1 = Col_Letter(x + 1)
SrcColsRange = stringArray(x) & ":" & stringArray(x)
DestColsRange = Col_char1 & ":" & Col_char1
''''''''' IT WORKS BUT WITHOUT SOURCE FILE FORMATTING '''''''''
ThisWorkbook.Worksheets(2).Range(DestColsRange).Value = srcWorkbook.Sheets(1).Range(SrcColsRange).Value
''''''''' IT DOESN'T WORK AND LOCKS EXCEL '''''''''
srcWorkbook.Sheets(1).Range(SrcColsRange).Copy Destination:=ThisWorkbook.Worksheets(2).Range(DestColsRange)
Next x
srcWorkbook.Close
MsgBox "File imported successfully!", vbInformation, "Finito!"
Please, try the next adapted code. It uses arrays to rapidly copy values and Application.Index function which is able to extract specific columns of the array (in a different order, if necessary...).
Then, it copies format, which takes longer, but it shouldn't kill Excel:
Sub ImportData()
Dim FileNameSrc As String, SrcColsRange As String, lastRow As Long, arr, arrColNo, arrFin, x As Long
Dim srcWorkbook As Workbook, wsSrc As Worksheet, wsDest As Worksheet, rngCopy As Range, stringArray
Const strCols As String = "D, E, G, F, K, L, M, Q, R, S, U, V, W, X, Z, AD, AE, AF, AH, AJ, AK, AL, AM, AW, AX"
stringArray = Split(strCols, ", ")
FileNameSrc = "your Workbook to import from full name" 'Please, use here the real full name!
Set srcWorkbook = Workbooks.Open(FileNameSrc)
Set wsSrc = srcWorkbook.Sheets(1)
lastRow = wsSrc.Range("A1").SpecialCells(xlCellTypeLastCell).Row 'last row of the larger column
Set rngCopy = wsSrc.Range("A1:" & stringArray(UBound(stringArray)) & lastRow) 'set the range to be processed
arr = rngCopy.Value 'place the range to be processed in an array
arrColNo = getArrColsNo(strCols, ", ") 'load an array of necessary columns to be returned NUMBERS
arrFin = Application.Index(arr, Evaluate("row(1:" & UBound(arr) & ")"), arrColNo) ' The necessary final array!
Set wsDest = wsSrc.Next ' ThisWorkbook.Worksheets(2) 'set the destination sheet
wsDest.cells.ClearContents 'clear the destination sheet contents
'drop the final array content, at once and AutoFit the dropped columns:
With wsDest.Range("A1").Resize(UBound(arrFin), UBound(arrFin, 2))
.Value = arrFin
.EntireColumn.AutoFit
End With
'copy each column format (this part will take some time...):
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For x = 0 To UBound(arrColNo)
rngCopy.Columns(arrColNo(x)).Copy
wsDest.cells(1, x + 1).PasteSpecial xlPasteFormats 'paste only the format of the copied column
Next x
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
wsDest.Activate 'activate the destination sheet...
srcWorkbook.Close
MsgBox "File imported successfully!", vbInformation, "Finito!"
End Sub
Please, send some feedback after testing it.