I need summ column values from multiple workbooks and worksheets in single worksheet. If i’m trying do it like this:
While targetCell.Row <> LastRow targetCell.Value = targetCell.Value + sourseCell.Value Set sourseCell = sourseSheet.Cells(sourseCell.Row + 1, sourseCell.Column) Set targetCell = targetSheet.Cells(targetCell.Row + 1, targetCell.Column) Wend
It takes too much time(Hours!!!).
targetSheet.Range("D14:BJ" & LastRow).Value = targetSheet.Range("D14:BJ" & LastRow).Value + sourseSheet.Range("D14:BJ" & LastRow).Value
I’m sometimes have error type mismatch
For Each foldername In subFolders If foldername <> ThisWorkbook.path Then filePath = foldername & fileName Dim app As New Excel.Application app.Visible = False Dim book As Excel.Workbook Set book = app.Workbooks.Add(filePath) For Each targetSheet In ActiveWorkbook.Worksheets Dim sourseSheet As Worksheet Set sourseSheet = book.Worksheets(targetSheet.Name) Call CopyColumn(targetSheet, sourseSheet, LastRow) Next book.Close SaveChanges:=False app.Quit Set app = Nothing End If Next Sub CopyColumn(targetSheet, sourseSheet As Worksheet, LastRow As Integer) Dim sourseCell, targetCell As Range Set targetCell = targetSheet.Cells(14,"D") Set sourseCell = sourseCell.Cells(14,"CH") While targetCell.Row <> LastRow targetCell.Value = targetCell.Value + sourseCell.Value Set sourseCell = sourseSheet.Cells(sourseCell.Row + 1, sourseCell.Column) Set targetCell = targetSheet.Cells(targetCell.Row + 1, targetCell.Column) Wend End Sub
Copying the ranges to
Variant arrays is quite fast. Your subroutine amended and commented below:
Sub CopyColumn(targetSheet As Worksheet, sourseSheet As Worksheet, LastRow As Long) ' LastRow as Integer will give an error for rows > 32,767, use Long instead ' Check the syntax: sourseCell, targetCell as Range means: ' sourceCell as Variant, targetCell as Range. We should include ' "as Range" after each variable declaration if we want it to be a Range Dim sourseCell As Range, targetCell As Range Dim lCount As Long Dim vTarget, vSource ' I kept the names targetCell, sourseSheet, but turned them to ranges ' You might want to change sourseSheet to sourceSheet With targetSheet Set targetCell = .Range(.Cells(14, "D"), .Cells(LastRow, "D")) End With ' I assume you mean sourceSheet instead of sourceCell, ' in your original code? With sourseSheet Set sourseCell = .Range(.Cells(14, "CH"), .Cells(LastRow, "CH")) End With vTarget = targetCell.Value2 vSource = sourseCell.Value2 ' If there is a change you do not have numeric values ' this needs error trapping For lCount = LBound(vTarget, 1) To UBound(vTarget, 1) vTarget(lCount, 1) = vTarget(lCount, 1) + vSource(lCount, 1) Next lCount targetCell.Value = vTarget End Sub
Option Explicit Private Declare Function GetTickCount Lib "kernel32.dll" () As Long Sub test_copy_column() Dim targetSheet As Worksheet, sourseSheet As Worksheet, LastRow As Long, _ tick As Long ' Maybe change sourseSheet to sourceSheet :) tick = GetTickCount ' Clock count Set targetSheet = Sheet1 Set sourseSheet = Sheet1 LastRow = 50000 ' I inputted random numbers for testing CopyColumn targetSheet, sourseSheet, LastRow MsgBox "Time to copy: " & GetTickCount - tick & " milliseconds" End Sub
I hope that helps!
for fast non-VBA solution, open all workbooks and insert following formula into a helper sheet:
=first_cell_from_source_workbook + first_cell_from_target_workbook + ...
copy the formula to cover whole range you need to cover.
copy & paste-special-as-values to target range if you wish to replace the original values in target range..
each time you wish to recalculate, make sure all source workbooks are open.