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

У меня есть одна главная книга с одним листом, в котором все данные заполняются каждые 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

wsCopy.Range(wsCopy.Cells(i, 2), wsCopy.Cells(i, 15)).Copy Для любого использования диапазона/ячейки требуется квалификатор рабочего листа. Вы также можете использовать что-то вроде wsCopy.Cells(i, 2).Resize(1, 14).Copy

— 31.08.2024 22:54

excel vba

31.08.2024 21:43

Преобразование HTML-таблицы в профессиональный документ Excel

Это самый простой способ создания Excel из HTML-таблицы.

Импорт excel в laravel в базу данных

Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...

Перейти к ответу Данный вопрос помечен как решенный

Ответы 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

Спасибо за ответ, Уильямс, я все еще получаю сообщение об ошибке «Требуется объект» wsCopy.Cells(i, 2).Resize(1, 14).Copy _ .Cells(.Rows.Count, «A»).End( XLUp).Смещение (1)

— 01.09.2024 06:36

Также хотел проверить, есть ли какой-нибудь способ запускать этот Sub каждые 5 минут и завершать этот Sub при каком-то условии с помощью кнопки в Excel.

— 01.09.2024 06:53

Copy не любит, когда его таким образом «раскалывают». «Разделить» строку где-нибудь еще или, например. замените нижнюю часть строки на Destination:=.Cells(.Rows.Count, "A").End(xlUp).Offset(1).

— 01.09.2024 12:50

@ VBasic2008 - да, я никогда такого раньше не видел. Исправил выше, спасибо.

— 01.09.2024 19:29

Чтобы запланировать запуск макроса в заданное время или в цикле, вы можете использовать Application.OnTime

— 01.09.2024 23:25

31.08.2024 23:03

Ответ принят как подходящий

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

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

01.09.2024 12:27

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

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

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

02.09.2024 09:13