Multi step Скопируйте и вставьте скрипт VBA

Question

Я пытаюсь извлечь данные (ячейки) из четырех результатов теста (каждый из которых отличается от другого файла excel), чтобы среднее значение можно было вычислить в шаблоне. Затем, чтобы выполнить цикл и сделать то же самое со следующими четырьмя тестами, но сценарий VBA помещает ячейки y вниз. Я пытаюсь сделать то следующее,

1. Для защиты клеток для некоторых из них, за исключением данных input.- Совершено
2. После нажатия кнопки вставленный запустить сценарий VBA, который будет копировать и вставлять отдельные клетки из четыре другие книги Excel. Сделано
3. После того, как эти четыре копии и вставляются, для сценария VBA нужно зацикливать, но вставьте ячейки количества.
4. И последнее, чтобы сохранить, так как это общедоступный шаблон и не хочет, чтобы он был изменен.

У меня возникли проблемы с 3-4, до сих пор у меня есть следующее для кода ..., но я не очень много знал об этом, чтобы узнать порядок/правильные коды команд.

Что я так далеко

Шаг 1: Готово

Sub ProtectSheetDataInput() 

Worksheets("DataInput").Cells.Locked = False 
Worksheets("DataInput").Range("A1:B283,C1:N3").Locked = True 
Worksheets("DataInput").Protect Password:="----coop", UserInterfaceOnly:=True 

End Sub 

Шаг 2: Готово

'Separate Macro  

Sub DataTransfer() 

Dim w As Workbook 'Test_Location 1 
Dim x As Workbook 'Test_Location 2 
Dim y As Workbook 'Test_Location 3 
Dim z As Workbook 'Test_Location 4 
Dim Alpha As Workbook 'Template 

Set w = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_1.xls") 
Set x = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_2.xls") 
Set y = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_3.xls") 
Set z = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_4.xls") 
Set Alpha = Workbooks("FRF_Data_Sheet_Template.xlsm") 

    Alpha.Sheets("DataInput").Range("C4:E8").Value = w.Sheets("Data").Range("I3:K7").Value 
    Alpha.Sheets("DataInput").Range("F4:H8").Value = x.Sheets("Data").Range("I3:K7").Value 
    Alpha.Sheets("DataInput").Range("I4:K8").Value = y.Sheets("Data").Range("I3:K7").Value 
    Alpha.Sheets("DataInput").Range("L4:N8").Value = z.Sheets("Data").Range("I3:K7").Value 

    w.Close False 
    x.Close False 
    y.Close False 
    z.Close False 

End Sub 

Шаг 3 Обновление: Надоело делать If найдите пробел в столбце C, затем Paste ... не работает. Ошибка при

If Columns("C").Value = "" Then 

«типа несовпадения»

Sub DataTransfer() 

Application.ScreenUpdating = False 
Dim w As Workbook 'Test_Location 1 
Dim x As Workbook 'Test_Location 2 
Dim y As Workbook 'Test_Location 3 
Dim z As Workbook 'Test_Location 4 
Dim Alpha As Workbook 'Template 
Dim Emptyrow As Long 'Next Empty Row 

    Set w = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_1.xls") 
    Set x = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_2.xls") 
    Set y = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_3.xls") 
    Set z = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_4.xls") 
    Set Alpha = Workbooks("FRF_Data_Sheet_Template.xlsm") 

     If Columns("C").Value = "" Then 
      Alpha.Sheets("DataInput").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = w.Sheets("Data").Range("I3:K7").Value 
      Alpha.Sheets("DataInput").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = x.Sheets("Data").Range("I3:K7").Value 
      Alpha.Sheets("DataInput").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = y.Sheets("Data").Range("I3:K7").Value 
      Alpha.Sheets("DataInput").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = z.Sheets("Data").Range("I3:K7").Value 

      w.Close False 
      x.Close False 
      y.Close False 
      z.Close False 
     End If 
Application.ScreenUpdating = True 
End Sub 

Тогда я попробовал другой подход, я получил эту работу между 2 листами, но я не могу заставить его работать Между несколько книг. Я получаю «Runtime Error» 9 'Subscript вне диапазона для этой строки.

Alpha.Sheets(DataInput).Activate 

'

Sub DataTransfer() 

Application.ScreenUpdating = False 
Dim w As Workbook 'Test_Location 1 
Dim x As Workbook 'Test_Location 2 
Dim y As Workbook 'Test_Location 3 
Dim z As Workbook 'Test_Location 4 
Dim Alpha As Workbook 'Template 
Dim Emptyrow As Range 

    Set w = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_1.xls") 
    Set x = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_2.xls") 
    Set y = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_3.xls") 
    Set z = Workbooks.Open("C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\location_4.xls") 
    Set Alpha = Workbooks("FRF_Data_Sheet_Template.xlsm") 
    Set EmptyrowC = Range("C" & Sheets("DataInput").UsedRange.Rows.Count + 1) 
    Set EmptyrowF = Range("F" & Sheets("DataInput").UsedRange.Rows.Count + 1) 
    Set EmptyrowI = Range("I" & Sheets("DataInput").UsedRange.Rows.Count + 1) 
    Set EmptyrowL = Range("L" & Sheets("DataInput").UsedRange.Rows.Count + 1) 

     w.Sheets("Data").Range("I3:K7").Copy 
     Alpha.Sheets(DataInput).Active 
      NextRow.PasteSpecial Paste:=xlValues, Transpose:=False 
      Application.CutCopyMode = False 
      Set NextRow = Nothing 
     x.Sheets("Data").Range("I3:K7").Copy 
      Alpha.Sheets(DataInput).Active 
      NextRow.PasteSpecial Paste:=xlValues, Transpose:=False 
      Application.CutCopyMode = False 
      Set NextRow = Nothing 
     y.Sheets("Data").Range("I3:K7").Copy 
      Alpha.Sheets(DataInput).Active 
      NextRow.PasteSpecial Paste:=xlValues, Transpose:=False 
      Application.CutCopyMode = False 
      Set NextRow = Nothing 
     z.Sheets("Data").Range("I3:K7").Copy 
      Alpha.Sheets(DataInput).Active 
      NextRow.PasteSpecial Paste:=xlValues, Transpose:=False 
      Application.CutCopyMode = False 
      Set NextRow = Nothing 

     w.Close False 
     x.Close False 
     y.Close False 
     z.Close False 

Application.ScreenUpdating = True 
End Sub 

Answer 1

Это одна не будет работать, она открывается из положить, но не копирует клетки

я не вижу вас открытие X Workbook.

Это работает для меня просто отлично, если ячейка в y.Sheets("Sheet1") разблокирована.

Также обратите внимание на использование .Value с обоих концов.

Sub DataTransfer() 
    Dim x As Workbook, y As Workbook 

    Set y = Workbooks.Open("C:\Users\aholiday\Desktop\Test_output.xlsm") 
    Set x = Workbooks.Open("C:\Blah Blah\Blah.xlsm") '<~~ Change as Applicable 

    y.Sheets("Sheet1").Range("A1:F5").Value = x.Sheets("InputSheet").Range("A1:F5").Value 
End Sub 

Answer 2

Скопировать в пункт назначения вместо.

y.Sheets("Sheet1").Range("A1:F5").Copy _   
    destination:=x.Sheets("InputSheet").Range("A1:F5")