Скопируйте данные из основной книги с одним листом в другую книгу с несколькими листами

У меня есть одна главная книга с одним листом, в котором все данные заполняются каждые 1 минуту, данные в каждой строке основного рабочего листа принадлежат одному конкретному листу другой рабочей книги,

хотите пройти через главный лист из Workbook1, чтобы получить каждую строку данных добавьте к каждому листу из Workbook2.

Ex: Workbook1(Sheet1)             Workbook2(sht1.....100+
    row1         append to         sht1 
    row2         append to         sht2
    row3         append to         sht3

Рабочая книга1 ==> Лист1 Рабочая тетрадь2==> шт1,шт2,шт3,шт4....до 100+

попробовал этот код ниже, он выдает ошибку, ссылаясь на диапазон ячеек основного листа и диапазон ячеек целевого листа

wsCopy.Range(Cells(S, 2), Cells(S, 15)).Copy _
        'wsDest.Range("B" & lDestLastRow)

Sub copy_eachrow_from_master()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
  

'EOD_DATA.xlsx is master workbook with Sheet1
'Temp_new.xlsm is having 100's of worksheets.

  Dim i As Long
  For i = 1 To 180
      Set wsCopy = Workbooks("EOD_DATA.xlsx").Worksheets("Sheet1")
      
     Set wsDest = Workbooks("Temp_new.xlsm").Worksheets(i)
     
     lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
             
    wsCopy.Range(Cells(i, 2), Cells(i, 15)).Copy _
        'wsDest.Range("A" & lDestLastRow)
        
    
    Next S
    MsgBox "Code done"
    

End Sub

2
57
3

Ответы:

Из комментария выше:

Sub copy_eachrow_from_master()

    Dim wsCopy As Worksheet, wbDest As Workbook, i As Long
      
    Set wsCopy = Workbooks("EOD_DATA.xlsx").Worksheets("Sheet1")
    Set wbDest = Workbooks("Temp_new.xlsm")

  
    For i = 1 To 180          
        With wbDest.Worksheets(i)
            wsCopy.Cells(i, 2).Resize(1, 14).Copy _   
                Destination:=.Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With     
    Next i
    MsgBox "Code done"

End Sub

Решено

Скопируйте каждую строку на другой лист

Sub ImportRowsFromMaster()
     
    ' Source (Read From) ('Master')

    Dim swb As Workbook: Set swb = Workbooks("EOD_DATA.xlsx")
    Dim sws As Worksheet:: Set sws = swb.Sheets("Sheet1")
    ' Adjust the row. It is unclear whether it is 1, 2 or something else
    ' i.e. the first row usually has headers.
    Dim srg As Range: Set srg = sws.Rows(1).Columns("B:O") ' !!!
    
    ' Destination (Written To) (has 100+ worksheets)
    
    ' If the following is the workbook containing this code,
    ' use 'Set dwb = ThisWorkbook' instead.
    Dim dwb As Workbook: Set dwb = Workbooks("Temp_new.xlsm")
    
    ' It is assumed that there are as many worksheets in the destination
    ' workbook as there are corresponding rows in the source sheet.
    
    Dim dws As Worksheet, dcell As Range, dwsIndex As Long
    
    For dwsIndex = 1 To dwb.Worksheets.Count
        Set dws = dwb.Worksheets(dwsIndex)
        Set dcell = dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1)
        srg.Copy Destination:=dcell
        Set srg = srg.Offset(1) ' next source row range
    Next dwsIndex
    
    MsgBox "Row data imported from Master.", vbInformation

End Sub

Спасибо всем за ответы, я внес соответствующие изменения, теперь все работает. размещение здесь на случай, если это поможет кому-то еще.

Sub copy_eachrow_from_master()
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lCopyLastRow As Long
    Dim lDestLastRow As Long


    Dim S As Long
    For S = 2 To 180
        Set wsCopy = Workbooks("EOD_DATA.xlsx").Worksheets("Sheet1")
  
        Set wsDest = Workbooks("Stocks_Analysis_Data.xlsm").Worksheets(S)
 
        lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
       
        
        wsCopy.Range(wsCopy.Cells(S, 2), wsCopy.Cells(S, 17)).Copy _
            wsDest.Range("B" & lDestLastRow)
            
        wsDest.Cells(lDestLastRow, 1).Value = Now

        Next S
   
End If

Конец субтитра