Hi from Montreal Canada
I'm a complete newb to vba
I need to transfer certain cells from 1Quotation Eng 2013 New macro (Worksheet) to Sales 2013 Test (sheet 1)
Quotation/Sales
C1>D1
C2>E1
C3>F1
B4>C1
I2>G1
--------------------------------------------------------------------------------------------------
Sub BulkImport()
Dim InFileNames As Variant
Dim OutFileName As String
Dim fCtr As Long
Dim tempWks As Worksheet
Dim consWks As Worksheet
Dim destCell As Range
Dim myRow As Long
Dim total As Long
Dim LastRow As Long
Set consWks = ActiveWorkbook.Sheets(1)
LastRow = consWks.Range("A65536").End(xlUp).Row
InFileNames = Application.GetOpenFilename _
(FileFilter:="Excel Files, *.xlsx", MultiSelect:=True)
Application.ScreenUpdating = False
If IsArray(InFileNames) Then
For fCtr = LBound(InFileNames) To UBound(InFileNames)
Set tempWkbk = Workbooks.Open(Filename:=InFileNames(fCtr))
consWks.Range("D" & fCtr + LastRow).Value = tempWkbk.Worksheets(2).Range("C1").Value
consWks.Range("E" & fCtr + LastRow).Value = tempWkbk.Worksheets(2).Range("C2").Value
consWks.Range("F" & fCtr + LastRow).Value = tempWkbk.Worksheets(2).Range("C3").Value
consWks.Range("C" & fCtr + LastRow).Value = tempWkbk.Worksheets(2).Range("B4").Value
consWks.Range("G" & fCtr + LastRow).Value = tempWkbk.Worksheets(2).Range("I2").Value
consWks.Range("S" & fCtr + LastRow).Value = tempWkbk.Name
ActiveWorkbook.Close
Next fCtr
Else
MsgBox "No file selected"
End If
With Application
.StatusBar = False
.ScreenUpdating = True
End With
End Sub
I was hoping someone can help me out.
Thanks in advance
Moderator's Note: Welcome to the forum, btw when posting codes the codes should be wrapped with code tags. Select the code then hit the "#" symbol. I'll do it for now. Thank for joining.
Bookmarks