VBA, Transferring of Data from one File to another

Question

I have this code that:

1. Clears my worksheet from row 12 and onward in Workbook A
2. Opens a new file Workbook B
3. Copys the sheet to my Workbook A. and Close Workbook B
4. Renames sheet in Workbook A
5. Transfers data from New Sheet to another Tab.

This seems to take me 10 minutes+, it is roughly 35k Rows.

Is there a faster way of doing this?

Thanks.

 Sub Mainsub()
 
 Worksheets("Main Data").Rows("12:" & Rows.Count).ClearContents
 
 'Copy data from the CM File to Template
 Application.ScreenUpdating = False
 
 'Open CM file
 Set MainDataCM = Workbooks.Open(Sheets("Input").Range("B16") & Sheets("Input").Range("B19"))
 'Copy main data tab to EPM file workbook
 MainDataCM.Sheets("Main Data").Copy After:=ThisWorkbook.Sheets(1)
 'Close CM Comm file
 MainDataCM.Close SaveChanges:=False
 Application.ScreenUpdating = True
 
 
 
 Sheets("Main Data (2)").Name = "CM_MainData"
 
 Worksheets("CM_MainData").Visible = False
 
 'Read the CM_MainData tab and copy the required columns in the MainData tab
 Dim k As Long
 k = Sheets("CM_MainData").Range("A1", Sheets("CM_MainData").Range("A1").End(xlDown)).Rows.Count
 Debug.Print (k)
 
 i = 12
 j = 2
 
 While j <= k
 Sheets("Main Data").Range("A" & i) = Sheets("CM_MainData").Range("A" & j)
 Sheets("Main Data").Range("B" & i) = Sheets("CM_MainData").Range("B" & j)
 Sheets("Main Data").Range("C" & i) = Sheets("CM_MainData").Range("C" & j)
 Sheets("Main Data").Range("D" & i) = Sheets("CM_MainData").Range("D" & j)
 Sheets("Main Data").Range("E" & i) = Sheets("CM_MainData").Range("E" & j)
 Sheets("Main Data").Range("F" & i) = Sheets("CM_MainData").Range("F" & j)
 Sheets("Main Data").Range("G" & i) = Sheets("CM_MainData").Range("G" & j)
 Sheets("Main Data").Range("H" & i) = Sheets("CM_MainData").Range("H" & j)
 Sheets("Main Data").Range("I" & i) = Sheets("CM_MainData").Range("I" & j)
 Sheets("Main Data").Range("J" & i) = Sheets("CM_MainData").Range("J" & j)
 Sheets("Main Data").Range("K" & i) = Sheets("CM_MainData").Range("K" & j)
 Sheets("Main Data").Range("L" & i) = Sheets("CM_MainData").Range("L" & j)
 Sheets("Main Data").Range("M" & i) = Sheets("CM_MainData").Range("M" & j)
 Sheets("Main Data").Range("N" & i) = Sheets("CM_MainData").Range("N" & j)
 Sheets("Main Data").Range("O" & i) = Sheets("CM_MainData").Range("O" & j)
 Sheets("Main Data").Range("P" & i) = Sheets("CM_MainData").Range("P" & j)
 
 i = i + 1
 j = j + 1
 Wend
 
 Worksheets("Input").Activate
 Worksheets("Input").Select
 
 MsgBox "Step 1 Completed"
End Sub

Answer 1

Seems like instead of transferring, Copying the Data and using ThisWorkbook was able to get the job done easily.

Sub Mainsubtwo()
Call Reset
Worksheets("Main Data").Rows("12:" & Rows.Count).ClearContents
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Open CM file
Set MainDataCM = Workbooks.Open(Sheets("Input").Range("B16") & Sheets("Input").Range("B19"))
With Sheets("Main Data")
lastrow = Sheets("Main Data").Range("A" & .Rows.Count).End(xlUp).Row
Sheets("Main Data").Range("A2:P" & lastrow).Copy
End With
'Paste into this workbook
ThisWorkbook.Sheets("Main Data").Range("A12").PasteSpecial xlPasteValues
'Close CM file
MainDataCM.Close SaveChanges:=False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Worksheets("Input").Activate
Worksheets("Input").Select
MsgBox "Step 1 Completed"
End Sub

Answer 2

Copy a Range From One File to Another

• s - Source (read from), d - Destination (written to)

• The code is still far from perfect but may be more educational for you to primarily understand the 'concept' of qualifying the objects:

  Dim wb As Workbook: Set wb = ThisWorkbook ' continue using 'wb'
  Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1") ' continue using 'ws'
  Dim fCell As Range: Set fCell = ws.Range("A2") ' continue using 'fCell'
  Dim lCell As Range: Set lCell = ws.Cells(ws.Rows.Count, "A").End(xlUp)
  Dim rg As Range: Set rg = ws.Range(fCell, lCell) ' continue using 'rg'
  

  etc. (it's for a one-column range)

• Copying by assignment is by far the most efficient way to copy values (only):

  Dim srg As Range: Set srg = Range("A1:D10")
  Dim dCell As Range: Set dCell = Range("F1")
  dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value
  

  If you additionally do...

  Dim drg As Range: Set drg = dCell.Resize(srg.Rows.Count, srg.Columns.Count)
  Debug.Print drg.Address(0, 0)
  

  then the result (the address of the Destination Range) printed in the Immediate window will be F1:I10.

The Code

Option Explicit
Sub CopyMainData()
 
 ' Create a reference to the Destination Workbook.
 Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
 
 ' Retrieve Source Workbook Path and Name.
 Dim swbPath As String, swbName As String
 With dwb.Worksheets("Input")
 swbPath = .Range("B16").Value
 swbName = .Range("B19").Value
 End With
 
 Application.ScreenUpdating = False
 
 ' Declare the Source Workbook variable.
 Dim swb As Workbook
 
 ' Check if a workbook with the same name as the name of the Source Workbook
 ' is already open. If so, close it saving any changes (or not?).
 On Error Resume Next
 Set swb = Workbooks(swbName)
 On Error GoTo 0
 If Not swb Is Nothing Then
 swb.Close SaveChanges:=True
 End If
 
 ' Attempt to open the Source Workbook.
 On Error Resume Next
 Set swb = Workbooks.Open(swbPath & swbName)
 On Error GoTo 0
 If swb Is Nothing Then
 MsgBox "The Workbook doesn't exist."
 Exit Sub
 End If
 
 ' If you feel that the previous two code blocks (scenarios)
 ' are not necessary (ridiculous) then replace them with:
 'Set swb = Workbooks.Open(swbpath & swbName)
 
 ' The 'Call' keyword is considered deprecated.
 Reset ' Reset what? e.g. 'ResetData' or 'ResetMain' are better names.
 
 ' Create a reference to the Source Range.
 Dim srg As Range
 With swb.Worksheets("Main Data")
 Dim sLastRow As Long: sLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
 Set srg = .Range("A2:P" & sLastRow)
 End With
 ' Maybe this would be more appropriate (make sure to test it):
' With swb.Worksheets("Main Data").Range("A1").CurrentRegion
' Set srg = .Resize(.Rows.Count - 1).Offset(1)
' End With
 
 ' Calculate the rows count of the (same-sized) ranges.
 Dim rCount As Long: rCount = srg.Rows.Count
 
 ' Using the reference to the Destination First Row Range ('A12:P12')...
 With dwb.Worksheets("Main Data").Range("A12").Resize(, srg.Columns.Count)
 ' Create a reference to the Destination Range.
 Dim drg As Range: Set drg = .Resize(rCount)
 ' Copy the values of the Source Range to the Destination Range
 ' by 'assignment'.
 drg.Value = srg.Value
 ' Create a reference to the Destination Clear Range, the range
 ' below the Destination Range.
 Dim dcrg As Range
 Set dcrg = .Resize(dws.Rows.Count - .Row - rCount + 1).Offset(rCount)
 ' Clear the contents of the Destination Clear Range
 dcrg.ClearContents
 End With
 
 ' Save and close.
 swb.Close SaveChanges:=False
 'dwb.Save
 
 Application.ScreenUpdating = True
 
 MsgBox "Main data copied."
End Sub