Announcement

Collapse
No announcement yet.

Using Macro to pull data from one window to another

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • DONALDFC
    started a topic Using Macro to pull data from one window to another

    Using Macro to pull data from one window to another

    THIS IS DRIVING ME MAD!!! I have the simple code that loops through a copy and paste process that will reformat a large amount of data into the format that I need it by pulling it from one file into another that has a bunch of formulas that bring up the needed data, then the macro sorts and lists the data before moving on to the next column. I have used this multiple times now; it even ran for 5 hours and produced 25000 lines of reformatted data. But now, without changing a thing except what computer I used it on, it won't recognize the other window. The code Windows("Materials Procurement - 2019 3.14.19.xlsx").Activate is used multiple times and never had any issue, but now it is bringing up Runtime Error 9, Subscript out of range. I tried going back to the original computer and it won't work there either. If someone else can see a problem please help me.

    Code:
    Sub SuperMacro()
    '
    ' SuperMacro Macro
    '
    
    ' GET THE CURRENT OEM DATA
    Windows("Materials Procurement - 2019 3.14.19.xlsx").Activate
    Application.CutCopyMode = False
    Columns("A:E").Select
    Selection.Copy
    
    ' TRANSFER THE CURRENT OEM DATA
    Windows("ProductStructure_FullBOM-3-16-19.2.xlsm").Activate
    Columns("A:A").Select
    
    ' PAST CURRENT EOM DATA
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Range("F1").Select
    
    
    '
    i = 1
    Do Until i > 260
    
    ' GET DATA FROM OLD FILE STRUCTURE
    Windows("Materials Procurement - 2019 3.14.19.xlsx").Activate
    Application.CutCopyMode = False
    Columns(i + 17).Select
    Selection.Copy
    
    ' RETURN TO PRODUCT STRUCTURE SPREADSHEET
    Windows("ProductStructure_FullBOM-3-15-19.xlsm").Activate
    Columns("F:F").Select
    
    ' PAST ACQUIRED DATA INTO FORMULAS
    ActiveSheet.Paste
    Columns("G:P").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    ' TRANSFER FORMULA RESULTS TO BE SORTED AND ORGANIZED
    Columns("R:R").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Calculator").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Calculator").Sort.SortFields.Add2 Key:=Range( _
    "R1:R6501"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
    With ActiveWorkbook.Worksheets("Calculator").Sort
    .SetRange Range("R1:AA6501")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    ActiveSheet.Range("$R$1:$AA$6502").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), _
    Header:=xlNo
    
    ' VERIFY THE SIZE OF THE DATA
    If Application.WorksheetFunction.CountA(Columns("R:R")) > 2 Then
    ' IF MUTILPLE LINE ITEMS
    Range("R2").Select
    Range(Selection, Selection.Offset(0, 9)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    ActiveSheet.Next.Select
    Range("A1").Select
    If IsEmpty(Range("A2").Value) = True Then
    Range("A2").Select
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    Else
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    End If
    ActiveSheet.Previous.Select
    ' IF ONE LINE ITEM
    ElseIf Application.WorksheetFunction.CountA(Columns("R:R")) = 2 Then
    Range("R2:AA2").Select
    Selection.Copy
    ActiveSheet.Next.Select
    Range("A1").Select
    If IsEmpty(Range("A2").Value) = True Then
    Range("A2").Select
    ActiveSheet.Paste
    Else
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    End If
    ActiveSheet.Previous.Select
    ' IF NO LINE ITEMS
    End If
    Selection.End(xlUp).Select
    Columns("R:AA").Select
    Selection.Delete
    Range("F1").Select
    i = i + 1
    Loop
    End Sub
    Last edited by KjBox; March 17th, 2019, 15:58.

  • KjBox
    replied
    Can you attach both workbooks.

    Leave a comment:


  • KjBox
    replied
    One of the rules you agreed to was to enclose all code in code tags.

    To do so you need to highlight any code after pasting it in the post or reply then click the # icon.

    I have added the tags for you on this occasion, but please make sure you do so yourself in future.

    Thank you.

    Leave a comment:

Working...
X