Переместить данные с одного листа на другой с помощью VBA

Question

У меня есть книга Excel с 4 листами.

1. Мастер лист
2. test_1
3. test_2
4. test_3

Я хочу переместить данные из мастер-листа на все остальные листы, что я и сделал, создав макрос. Ежедневно данные мастер-листа будут увеличиваться, так как я могу учесть это изменение в макросе.

Я вставил свой существующий код ниже:

Sub sbCopyRangeToAnotherSheet()
    Sheets("Master").Range("B10:M1628").Copy
    Sheets("test_1").Activate
    Range("B9").Select
    ActiveSheet.Paste
    Application.CutCopyMode = Flase
End Sub


Sub sbCopyRangeToCRP2()
    Sheets("Master").Range("B10:M1628").Copy
    Sheets("test_2").Activate
    Range("B9").Select
    ActiveSheet.Paste
    Application.CutCopyMode = Flase
End Sub


Sub sbCopyRangeToCRP3()
    Sheets("Master").Range("B10:M1628").Copy
    Sheets("test_3").Activate
    Range("B9").Select
    ActiveSheet.Paste
    Application.CutCopyMode = Flase
End Sub

В приведенном выше коде я упомянул жестко закодированное значение диапазона мастер-листа, которое начинается с B10 и заканчивается на M1628.

В дальнейшем количество строк увеличивается **(диапазон B10 останется)** и я не хочу жестко кодировать диапазон. Как я могу сделать это?

Answer 1

Я предлагаю объединить эти 3 подпрограммы в одну, которую вы можете использовать повторно, указав рабочий лист в качестве параметра:

Sub sbCopyRangeToAnotherSheet(ToSheet As Worksheet)
    Dim LastUsedRow As Long

    With Sheets("Master")
        LastUsedRow = .UsedRange.Row + .UsedRange.Rows.Count - 1
        .Range("B10:M" & LastUsedRow).Copy ToSheet.Range("B9")
    End With

    Application.CutCopyMode = False
End Sub

Затем вы можете запустить этот саб для любого имени листа, как

Sub test_1()
    sbCopyRangeToAnotherSheet Sheets("test_1")
    'and for the second sheet
    sbCopyRangeToAnotherSheet Sheets("test_2")
End Sub

Answer 2

Я бы предложил либо использовать UsedRange свойство объекта Worksheet,

или определить именованные диапазоны на листе, которые автоматически расширяются по мере роста данных на листе, например: =OFFSET($A$1,0,0,COUNTA($A:$A),1)

Answer 3

Вы можете использовать этот макрос

Sub CopyAll()
    Dim src As Range, dest
    With Worksheets("Master") ' set the source range
        Set src = .Range("B10:M" & .Cells(.Rows.Count, "B").End(xlUp).Row)
    End With
    For Each dest In Array("test_1", "test_2", "test_3") ' loop on destination sheets
        src.Copy Worksheets(dest).Range("B9")
    Next
End Sub

Answer 4

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

1. Создать точный массив
2. Заполните данные из мастер-листа
3. Вставьте данные.

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

Sub sbCopyRangeToAnotherSheet()
Sheets("Master").Select
Dim RowNum as integer 
For i = 0 To 250000 'Count all rows
    If IsEmpty(Cells(i + 10, 2)) = False Then
        RowNum = RowNum + 1 'Count all rows which have data in it's second column
    Else
        Exit For
    End If
Next
ReDim myData(RowNum - 1, 12) As String 'create array
For i = 0 To RowNum - 1 'fill array, with data
    For j = 0 to 12
    myData(i, j) = Cells(i + 10, j+2) '+10 because you said B**10**
                                      '+2 because you said **B**10
    Next
Next

Sheets("test_1").Activate
For i = 0 To RowNum - 1 'fill array, with data
    For j = 0 to 12
    Cells(i + 10, j+2) = myData(i, j) 'Fill cells with data
    Next
Next
End Sub