Multi step Copy and paste VBA script

Question

I'm trying to pull data (cells) from four test result (each a different excel file) so that the average can be calculated within the template. Then to loop and do the same thing with the next four test but have the VBA script place y cells down. I'm trying to do exactly the following,

To protect the cells except for certain ones for data input.- Done
Upon pushing an inserted button run a VBA script that will copy and paste certain cells from four other excel workbooks. Done
After those four are copy and pasted, for the VBA script to loop but paste y amount cells down.
And last to force save as for this is a public template and don't want it to be changed.

I'm having trouble with 3-4, So far i have the following for code..., but i haven't done very much of this to know order/ correct code commands.

What i Have so Far

Step 1:Done

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

Step 2: Done

'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

Step 3 Update: Tired to do a If find blank in Column C then Paste... did not work. Error at

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

"type mismatch"

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

Then i Tried a different approach, I got this to work between 2 worksheets but i cant get it to work Between Multiple Workbooks. I get 'Runtime Error '9' Subscript out of range for this line.

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

You could do a copy to destination instead. y.Sheets("Sheet1").Range("A1:F5").Copy destination:=x.Sheets("InputSheet").Range("A1:F5") — Liss
Run time error '91' object variable or block variable not set. — Duraholiday
no matter what, you have to tell it what X is. just telling the compiler X is a workbook only gets you 1/2 way there. Set X to be the name of the ActiveWorkbook (or whatever the name of the source workbook is) should get you closer... — sous2817

Siddharth Rout Siddharth Rout · Accepted Answer · 2015-08-05T20:28:17

This one wont work, it opens the out put but doesn't copy the cells

I don't see you opening the X Workbook.

This works for me just fine, provided the cell in y.Sheets("Sheet1") are unlocked.

Also notice the use of .Value on both ends.

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

Multi step Copy and paste VBA script

2 Answers