Search code examples
excelvba

Copy data from Master workbook with one sheet to another workbook with multiple sheets


I have one master workbook with one sheet having all the data pupulating every 1 min, data in each row from master work sheet belongs one specific sheet on another workbook,

want to loop through master worksheet from Workbook1 get each row of data append to the each worksheet from Workbook2.

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

Workbook1 ==> Sheet1 Workbook2==> sht1,sht2,sht3,sht4....upto 100+

have tried this below code it is giving error referencing master sheet cell range and destination sheet cell range

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

Solution

  • Copy Each Row to a Different Worksheet

    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