• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Cant paste to the destination file for consolidation

Gkming1125

New Member
Hi all,
Hope my post here finds you well. Could anyone help as I've been struggling and i can't identify the errors in the code.

Background:
1. I copied the VBA module from book A to book B. The code works well in Book A with no issues, i just need to duplicate the same module in Book B.
2. Book B is my destination, which i want to copy from 10 country files (Australia.xlsx, New Zealand.xlsx), with the name of "Input_capex" tab in each country file to Book B for consolidation.
3. From 2, they will be pasted into each different country tab in Book B. For eg. Australia pasted in "AU" tab in Book B.
4. A "List" tab as the strings in Book B and i have assigned this macros to this tab. Example as below:

67722

Below is the code:

>>> use code - tags <<<
Code:
Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook
Public strCopyRange As String

Sub GetData()
    Dim strWhereToCopy As String, strStartCellColName As String
    Dim strListSheet As String
 
    strListSheet = "List"
 
    On Error GoTo ErrH
    Sheets(strListSheet).Select
    Range("B2").Select
 
    'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
    Set currentWB = ActiveWorkbook
    Do While ActiveCell.Value <> ""
     
        strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
        strCopyRange = ActiveCell.Offset(0, 2) & ":" & ActiveCell.Offset(0, 3)
        strWhereToCopy = ActiveCell.Offset(0, 4).Value
        strStartCellColName = Mid(ActiveCell.Offset(0, 5), 2, 1)
     
        Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
        Set dataWB = ActiveWorkbook
        Sheets("Input_Capex").Select
        Range(strCopyRange).Select
        Selection.Copy
     
        currentWB.Activate
        Sheets(strWhereToCopy).Select
        lastRow = LastRowInOneColumn(strStartCellColName)
        Cells(lastRow + 1, 1).Select
     
     
        Range("A1").Select
        Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False
        dataWB.Close False
        Sheets(strListSheet).Select
        ActiveCell.Offset(1, 0).Select
    Loop
    MsgBox "Done.", vbInformation, "Data Consolidated"
    Exit Sub
 
ErrH:
    MsgBox "It seems some file was missing. The data copy operation is not complete."
        Exit Sub
End Sub

Public Function LastRowInOneColumn(col)
    'Find the last used row in a Column: column A in this example
    'http://www.rondebruin.nl/last.htm
    Dim lastRow As Long
    With ActiveSheet
    lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
    End With
    LastRowInOneColumn = lastRow
End Function

I will straight away come into the error message when i start running my macros and return me to the error message: "It seems some file was missing. The data copy operation is not complete."

Could anyone see any errors in the code? Thanks in advance!
 
Last edited by a moderator:
Thanks Ateeb for reading my post. Attached are the example files, not sure if it can work this way.
 

Attachments

  • CapEx consol_Apr 2020.xlsm
    837.3 KB · Views: 3
  • Estimate-042020-AU.xlsx
    327.2 KB · Views: 2
  • Estimate-042020-ID.xlsx
    327.2 KB · Views: 1
  • Estimate-042020-IN.xlsx
    327.1 KB · Views: 1
hi @Gkming1125

See if is ok ?

Code:
Option Explicit

Sub Consolidate()

Dim FilePath As String, strCopyRange, WhereToCopy, CopyToStartCell, FilefullPath As String
Dim i As Long, lastrow

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("List")
lastrow = ws.Range("C10000").End(xlUp).Row
Dim Thisws As Workbook

For i = 2 To lastrow
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.CutCopyMode = False
    
    FilePath = ws.Cells(i, 3).Value
    strCopyRange = ws.Cells(i, 4).Value & ":" & ws.Cells(i, 5).Value
    WhereToCopy = ws.Cells(i, 6).Value
    
     On Error GoTo ErrorMsg
    Application.Workbooks.Open (FilePath)
    
    ActiveSheet.Activate
    Worksheets("Input_Capex").Activate
    Range(strCopyRange).Copy
    
    ThisWorkbook.Sheets(WhereToCopy).Range("A1").PasteSpecial xlPasteAll
    Application.CutCopyMode = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
    ActiveWindow.Close
    
Next i
MsgBox "Done.", vbInformation, "Data Consolidated"
Exit Sub
ErrorMsg:
    MsgBox "It seems some file was missing. The data copy operation is not complete."
End Sub
 

Attachments

  • CapEx consol_Apr 2020.xlsm
    221.6 KB · Views: 2
Back
Top