kbenjamin827
New Member
- Joined
- Jul 5, 2018
- Messages
- 17
Hi Guys,
I am looking for a way to open a folder, and have different workbooks open different files, using a partial title and then run specific programs.
For workbook1 I have this code:
For workobook2 I have this code:
Workbook 1 should automatically select "option 1" and workbook 2 should automatically select "option 2" and run the codes automatically.
Is this even possible?
I am looking for a way to open a folder, and have different workbooks open different files, using a partial title and then run specific programs.
For workbook1 I have this code:
Code:
Sub Foo()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Dim Fnd As Range
Dim Ary As Variant
Dim i As Long
Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
Ary = Array("Total", 24, "t-4", 4, "t-3", 5, "t-2", 6, "t-1", 7, "Behr SOP = t0", 8, "t1", 9, "t2", 10, "t3", 11, "t4", 12, "t5", 13, "t6", 14, "t7", 15, "t8", 16, "t9", 17, "t10", 18, "t11", 19, "t12", 20, "t13", 21, "t14", 22, "t15", 23)
'-------------------------------------------------------------
'Open file with data to be copied
vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", "Open", False)
'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(1)
End If
'--------------------------------------------------------------
'Copy Range
For i = 0 To UBound(Ary) Step 2
Set Fnd = wsCopyFrom.Range("5:5").Find(Ary(i), , , xlWhole, , , False, , False)
If Not Fnd Is Nothing Then
wsCopyFrom.Range(Fnd.Offset(1), wsCopyFrom.Cells(wsCopyFrom.Rows.Count, Fnd.Column).End(xlUp)).Copy
wsCopyTo.Cells(7, Ary(i + 1)).PasteSpecial xlPasteValues
End If
Next i
Application.CutCopyMode = False
wbCopyFrom.Close SaveChanges:=False
End Sub
For workobook2 I have this code:
Code:
Sub Foo()
Dim vFile As Variant
Dim wbCopyTo As Workbook
Dim wsCopyTo As Worksheet
Dim wbCopyFrom As Workbook
Dim wsCopyFrom As Worksheet
Set wbCopyTo = ActiveWorkbook
Set wsCopyTo = ActiveSheet
'-------------------------------------------------------------
'Open file with data to be copied
vFile = Application.GetOpenFilename("Excel Files (*.xl*)," & _
"*.xl*", 1, "Select Excel File", "Open", False)
'If Cancel then Exit
If TypeName(vFile) = "Boolean" Then
Exit Sub
Else
Set wbCopyFrom = Workbooks.Open(vFile)
Set wsCopyFrom = wbCopyFrom.Worksheets(1)
End If
'--------------------------------------------------------------
'Copy Range
wsCopyFrom.Range("B1:G43").Copy
wsCopyTo.Range("B4").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("H1:H43").Copy
wsCopyTo.Range("Q4").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("I1:N36").Copy
wsCopyTo.Range("B54").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsCopyFrom.Range("O1:O36").Copy
wsCopyTo.Range("Q54").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Close file that was opened
wbCopyFrom.Close SaveChanges:=False
End Sub
Workbook 1 should automatically select "option 1" and workbook 2 should automatically select "option 2" and run the codes automatically.
Is this even possible?