Transfer of data divided into chunks from one file to multiple files.

[dilshod_k]

Hello everyone,

I have multiple destination workbooks each one with a list of 100 symbols (one symbol per cell) in column A starting from cell A25.
I have also file "Source.csv" with a list of 2000+ symbols in column B starting from B2.
To copy and paste all 2000+ symbols in the column of a single workbook is not an option, this list needs to be divided into 100 symbols chunks and copied to destination workbooks one chunk per workbook.
The aim is to write code which would delete old symbols in destination workbooks (lets say A25 to A125) and replaced them by 100 symbols chunks (plus whatever remains after total number of symbols divided by 100 to the last destination workbook) taken from the file "Source.cvs". At the beginning and by the end of the code all files should be closed. The code should be running from the file called "Master.xlsm".
I would be grateful for any suggestions especially those that are not using Copy-Paste method in order to improve performance of the code. Thanks in advance.

 

[DanteAmor]

The name of the file with the macro has nothing to do, even in the macro it does not reference. It is very strange that this change causes the error.
Change the name of the file with the macro and change this line
Set ws2 = wb2.Sheets (1)
For this:
Set ws2 = wb2.Activesheet

Try again.

 

[dilshod_k]

The name of the file with the macro has nothing to do, even in the macro it does not reference. It is very strange that this change causes the error.
Change the name of the file with the macro and change this line
Set ws2 = wb2.Sheets (1)
For this:
Set ws2 = wb2.Activesheet

Try again.

I tried to make changes to the code as you told me, but it still transfers data to the first sheet (of destination files) instead of second, although it has stopped transferring data in any other file in the same directory with Master.xlsm and finviz.csv.

 

[DanteAmor]

Try the following to transfer to second sheet ("Control")

All target books must have the sheet called "Control"

Now you can put all the files in the same folder.

Sub Transfer_data()
'
    Dim wPath1 As String, wPath3 As String
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws2 As Worksheet, ws3 As Worksheet
    Dim wFiles As Variant, n As Double
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '
    wPath3 = "C:\Users\User\Downloads\Trading\Test\SpeedUp Tuning\New folder\"
    '
    Set wb1 = ThisWorkbook
    wPath1 = wb1.Path & "\"
    Set wb2 = Workbooks.Open(wPath1 & "finviz.csv")
    Set ws2 = wb2.ActiveSheet
    '
    wFiles = Dir(wPath3 & "*.xls*")
    n = 2
    Do While wFiles <> ""
        If wFiles <> wb1.Name Then
            Set wb3 = Workbooks.Open(wPath3 & wFiles)
            Set ws3 = wb3.Sheets("Control")
            ws3.Range("A25").Resize(100).Value = ws2.Range("B" & n).Resize(100).Value
            n = n + 100
            wb3.Close True
        End If
        wFiles = Dir()
    Loop
    wb2.Close False
    '
    MsgBox "End"
End Sub

 

[dilshod_k]

Try the following to transfer to second sheet ("Control")

All target books must have the sheet called "Control"

Now you can put all the files in the same folder.

Sub Transfer_data()
'
    Dim wPath1 As String, wPath3 As String
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws2 As Worksheet, ws3 As Worksheet
    Dim wFiles As Variant, n As Double
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '
    wPath3 = "C:\Users\User\Downloads\Trading\Test\SpeedUp Tuning\New folder\"
    '
    Set wb1 = ThisWorkbook
    wPath1 = wb1.Path & "\"
    Set wb2 = Workbooks.Open(wPath1 & "finviz.csv")
    Set ws2 = wb2.ActiveSheet
    '
    wFiles = Dir(wPath3 & "*.xls*")
    n = 2
    Do While wFiles <> ""
        If wFiles <> wb1.Name Then
            Set wb3 = Workbooks.Open(wPath3 & wFiles)
            Set ws3 = wb3.Sheets("Control")
            ws3.Range("A25").Resize(100).Value = ws2.Range("B" & n).Resize(100).Value
            n = n + 100
            wb3.Close True
        End If
        wFiles = Dir()
    Loop
    wb2.Close False
    '
    MsgBox "End"
End Sub

Now it works perfectly well! Not only that. Now it works without error messages even when the name of the file with macros is DataFile.
Thank you very much! Highly appreciate it.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.