Hi guys,
I need to copy information that matches a provider name from one Workbook/[Provider Sheet] to another workbook where I need it to append certain columns of all providers information.
So far I am using the code I found to choose the workbook/sheet/range from a windows and select the destination range but I would like to do automatically, without the need to choose the source Workbook/Sheet/Range.
The code I am using so far is this:
I need to copy information that matches a provider name from one Workbook/[Provider Sheet] to another workbook where I need it to append certain columns of all providers information.
So far I am using the code I found to choose the workbook/sheet/range from a windows and select the destination range but I would like to do automatically, without the need to choose the source Workbook/Sheet/Range.
The code I am using so far is this:
Code:
Sub ImportDatafromotherworksheet()
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook As Workbook
Dim rngSourceRange As Range
Dim rngDestination As Range
Set wkbCrntWorkBook = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xlsa"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
Workbooks.Open .SelectedItems(1)
Set wkbSourceBook = ActiveWorkbook
Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1", Type:=8)
wkbCrntWorkBook.Activate
Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8)
rngSourceRange.Copy rngDestination
rngDestination.CurrentRegion.EntireColumn.AutoFit
wkbSourceBook.Close False
End If
End With
End Sub