Need help with VBA Loop

[sparkytech]

I have the code below which opens Workbook 1 and copies columns into Workbook 2. The function is this: open Workbook 1, copy columns B to A, C to B, I to C, J to D, K to E, and L to F to Workbook 2. Everything sort of works, but the odd thing is it doesn't copy/paste the last one in the code (L to F). I've tried everything I can think of but can't get it to function correctly. What am I missing here, and is there a better way to do this?

Thanks!

Option Explicit

Private Sub Workbook_Open()
    Call ReadDataFromCloseFile
End Sub

Sub ReadDataFromCloseFile()
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    
    Dim src As Workbook
    Dim iCnt As Integer         ' COUNTER
    
    ' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
    Set src = Workbooks.Open("<redacted>.xlsx")
    
    ' GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK.
    Dim iTotalRows As Integer
    iTotalRows = src.Worksheets("Sheet B").Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row).Rows.Count
   
    ' COPY DATA FROM SOURCE (CLOSE WORKGROUP) TO THE DESTINATION WORKBOOK
    
    'Dim iCnt As Integer         ' COUNTER.
    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("A" & iCnt).Formula = src.Worksheets("Sheet B").Range("B" & iCnt).Formula
    Next iCnt
    
    'Dim iCnt As Integer         ' COUNTER.
    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("B" & iCnt).Formula = src.Worksheets("Sheet B").Range("C" & iCnt).Formula
    Next iCnt
    
    'Dim iCnt As Integer         ' COUNTER.
    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("C" & iCnt).Formula = src.Worksheets("Sheet B").Range("I" & iCnt).Formula
    Next iCnt
    
    'Dim iCnt As Integer         ' COUNTER.
    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("D" & iCnt).Formula = src.Worksheets("Sheet B").Range("J" & iCnt).Formula
    Next iCnt
    
    'Dim iCnt As Integer         ' COUNTER.
    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("E" & iCnt).Formula = src.Worksheets("Sheet B").Range("K" & iCnt).Formula
    Next iCnt
    
    'Dim iCnt As Integer         ' COUNTER.
    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("F" & iCnt).Formula = src.Worksheets("Sheet B").Range("L" & iCnt).Formula
    Next iCnt
    
       
    ' CLOSE THE SOURCE FILE.
    'src.Close savechanges:=False
    src.Close False             ' FALSE - DON'T SAVE THE SOURCE FILE.
    Set src = Nothing
    
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[Joe4]

Why do you have separate loops like this?

    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("A" & iCnt).Formula = src.Worksheets("Sheet B").Range("B" & iCnt).Formula
    Next iCnt
    
    'Dim iCnt As Integer         ' COUNTER.
    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("B" & iCnt).Formula = src.Worksheets("Sheet B").Range("C" & iCnt).Formula
    Next iCnt
    
    'Dim iCnt As Integer         ' COUNTER.
    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("C" & iCnt).Formula = src.Worksheets("Sheet B").Range("I" & iCnt).Formula
    Next iCnt
    
    'Dim iCnt As Integer         ' COUNTER.
    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("D" & iCnt).Formula = src.Worksheets("Sheet B").Range("J" & iCnt).Formula
    Next iCnt
    
    'Dim iCnt As Integer         ' COUNTER.
    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("E" & iCnt).Formula = src.Worksheets("Sheet B").Range("K" & iCnt).Formula
    Next iCnt
    
    'Dim iCnt As Integer         ' COUNTER.
    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("F" & iCnt).Formula = src.Worksheets("Sheet B").Range("L" & iCnt).Formula
    Next iCnt

Since you are looping through the exact same rows every time, I believe you should be able to combine them into one loop, which should speed up your code a bit (as loops are notoriously slow):

    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("A" & iCnt).Formula = src.Worksheets("Sheet B").Range("B" & iCnt).Formula
        Worksheets("Sheet1").Range("B" & iCnt).Formula = src.Worksheets("Sheet B").Range("C" & iCnt).Formula
        Worksheets("Sheet1").Range("C" & iCnt).Formula = src.Worksheets("Sheet B").Range("I" & iCnt).Formula
        Worksheets("Sheet1").Range("D" & iCnt).Formula = src.Worksheets("Sheet B").Range("J" & iCnt).Formula
        Worksheets("Sheet1").Range("E" & iCnt).Formula = src.Worksheets("Sheet B").Range("K" & iCnt).Formula
        Worksheets("Sheet1").Range("F" & iCnt).Formula = src.Worksheets("Sheet B").Range("L" & iCnt).Formula
    Next iCnt

Regarding your question, what exactly is the formula in column L on your source sheet?
What does it show in column F on your destination sheet (if you go to one of the cells and look in the formula editor)?
I just want to make sure that it actually isn't a situation in which that there is a formula in that cell that is just return a blank.

 

[rlv01]

I suspect you are getting a runtime error. Modify your Error handler code as per below so you can see any error message

ErrHandler:
    Dim Msg As String
   
    If Err.Number <> 0 Then
        Msg = "An error has occurred:" & vbCr & vbCr _
        & "     Runtime Error " & Err.Number & vbCr _
        & "     Desc: " & UCase(Err.Description) & vbCr & vbCr
        MsgBox Msg, vbCritical, "Error Report"
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
   
End Sub