0

The script runs without errors but it doesn't do whats its supposed to do, In fact it doesn't change anything in the documents. I test a part and the testing software spits out 4 workbooks that are saved in a folder named Location 1,2,3,4. Then i open a template, "alpha" in the script, that uses data from the previous workbook to show averages and to show tread of data. The macro is then activated by a button and its supposed to paste in the alpha workbook to the next empty row. The rows are 6 cells apart and 3 cells across.

Apperently i need 10 rep before pictures so heres a link to the picture.... In the picture One test is done, i have a macro for one test (row) but i cant get it to repeat and paste to the next empty down. If there is a better way of doing this please let me know haha. https://drive.google.com/file/d/0B9n6BtJ4Med8NlVGa2FySzEtMGM/view?usp=sharing

Sub DataTransfer()

 'simplified to 2 workbooks

Dim w As Workbook 'Test_Location 1
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 Alpha = Workbooks("FRF_Data_Sheet_Template.xlsm")
    Set EmptyrowC = Range("C" & Alpha.Sheets("DataInput").UsedRange.Rows.Count + 1)

        w.Sheets("Data").Range("I3:K7").Copy
        With Alpha.Sheets("DataInput")
        EmptyrowC.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = True


        End With

  End Sub

I also tried to do a If statement but got no where with that.

 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

Duraholiday
  • 111
  • 1
  • 3
  • 14
  • 1
    `Alpha.Sheets("DataInput").Activate` if that's actually the name of your sheet Note `Active` is not a method.... Also - you should avoid select/active: it's rarely necessary and makes your code unreliable. http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros – Tim Williams Aug 07 '15 at 17:07
  • `If Columns("C").Value = "" Then` which sheet is this intended to check? As posted it will use the active sheet by default. Also you can't check a whole column like that by comparing it to "" – Tim Williams Aug 07 '15 at 17:28
  • The first one is something i found on here but it was for 2 sheets in a workbook, i tried to change it for multiple workbooks. How can i improve this to get what im trying to achive? This is the 2nd script ive ever written – Duraholiday Aug 07 '15 at 17:43
  • The second is just a bunch of stuff ive gotten from the web that i tried putting together but im unfamiliar with commands to tell it what to do. Do you have a better way of accomplishing what im trying to do? Thanks – Duraholiday Aug 07 '15 at 17:45
  • Should i try replacing activate with 'With alpha.sheets(blah)'? is that what your saying? – Duraholiday Aug 07 '15 at 17:51
  • a) it's unclear on where `Set EmptyrowC = Range(...` is trying to set. b) `Alpha.Sheets(DataInput)` should be `Alpha.Sheets("DataInput")` like it is directly above c) `NextRow.PasteSpecial` you define EmptyrowC, etc above and then use `NextRow` without defining it (and repeatedly set it to nothing). d) I'm unclear on how this code ran at all. –  Aug 07 '15 at 17:55
  • @Jeeped a.) Im not sure, like i said im using something that worked for someone else, i just expanded it. b.) i fixed on my own but forgot to update on here. c.) dido with a. d.) it works but paste it in the wrong workbook in row 284 for some reason. Im going to simplify the above script so i can focus on 2 workbooks instead of 5. – Duraholiday Aug 07 '15 at 18:06
  • Where do you end up if you open the `alpha` workbook to the DataInput worksheet and tap Ctrl+End? –  Aug 07 '15 at 18:09

2 Answers2

1

Something like this:

Option Explicit

Sub DataTransfer()

    Const FPATH As String = "C:\Users\aholiday\Desktop\FRF_Data_Macro_Insert_Test\"

    Application.ScreenUpdating = False

    Dim wb As Workbook
    Dim shtAlpha As Worksheet 'Template
    Dim locs, loc
    Dim rngDest As Range

    locs = Array("location_1.xls", "location_2.xls", _
                 "location_3.xls", "location_4.xls")

    Set shtAlpha = Workbooks("FRF_Data_Sheet_Template.xlsm").Sheets("DataInput")

    'set the first data block destination
    Set rngDest = shtAlpha.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Resize(5, 3)

    For Each loc In locs

        Set wb = Workbooks.Open(Filename:=FPATH & loc, ReadOnly:=True)

        rngDest.Value = wb.Sheets("Data").Range("I3:K7").Value

        wb.Close False

        Set rngDest = rngDest.Offset(0, 3) 'move over to the right 3 cols

    Next loc

    Application.ScreenUpdating = True

End Sub

I'm not sure what you mean to do with that check on Column C, so I left that out...

Tim Williams
  • 154,628
  • 8
  • 97
  • 125
0

I've made a number of (reasonable...?) assumptions and rewrote the first code to use the variables that are set and define the specific workbook that various range(s) originate on.

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
    Dim EmptyrowC As Range, EmptyrowF As Range, EmptyrowI As Range, EmptyrowL As Range

    Application.ScreenUpdating = False

    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")

    With Alpha.Sheets("DataInput")
        Set EmptyrowC = .Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
        Set EmptyrowF = .Cells(Rows.Count, "F").End(xlUp).Offset(1, 0)
        Set EmptyrowI = .Cells(Rows.Count, "I").End(xlUp).Offset(1, 0)
        Set EmptyrowL = .Cells(Rows.Count, "L").End(xlUp).Offset(1, 0)

        w.Sheets("Data").Range("I3:K7").Copy Destination:=EmptyrowC
        x.Sheets("Data").Range("I3:K7").Copy Destination:=EmptyrowF
        y.Sheets("Data").Range("I3:K7").Copy Destination:=EmptyrowI
        z.Sheets("Data").Range("I3:K7").Copy Destination:=EmptyrowL

        w.Close False
        x.Close False
        y.Close False
        z.Close False
    End With

    Application.ScreenUpdating = True

End Sub

It's not 100% clear on whether you absolutely require a Range.PasteSpecial method so you get yo started, I've opted for the simpler Range.Copy method. If this is insufficient, then a direct value transfer would be preferred to a Copy, PasteSpecial, Values.

  • Ok!, its working! but it paste the data on the very bottom of the borders i made. In row C284. It must be viewing the cells with borders not empty. Is there a way around this? – Duraholiday Aug 07 '15 at 18:16
  • I was afraid of that. The row labels down column A were expanding the [Worksheet.UsedRange property](https://msdn.microsoft.com/en-us/library/office/ff840732.aspx). See my modification above. This new method will depend upon NOT having blank cells in columns C, F, I and L. If there are, then you may have your data shifted up a row. –  Aug 07 '15 at 18:21
  • Getting closer, Pastes in the right spot now but deletes all formatting... including the borders, text properties, averaging, mean, max, and min formulas – Duraholiday Aug 07 '15 at 18:57