Frankximus
New Member
- Joined
- Feb 13, 2016
- Messages
- 32
Hey guys, I've got some codes below that allows me to import a few columns into anther excel document, however I need to repeat it so it allows import of non adjacent columns. Currently it imports from A to J, but I need import column A to I and J to R and drop them in different columns. How do I repeat it so it allows me to do that?
Inputs from the source workbook: columns A to I, J to R
Outputs dropped in destination workbook: columns A to I and R to X,
Sub importcontact()
Dim actwb As Workbook
Dim LastRow As Long
Dim DestRow As Long
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim filename As Variant
Dim sFilename As String
Dim nbrMarkerRecs As Integer
Dim nbrProjectRecs As Integer
Dim nbrActivityRecs As Integer
Dim nbrWhatRecs As Integer
' Open File to load
filename = Application.GetOpenFilename(FileFilter:="Contact Import Files (*.txt; *.csv; *.xls; *.xlsx), *.txt;*.csv*.xls;*.xlsx", Title:="Import Contacts", MultiSelect:=False)
Set actwb = Workbooks.Open(filename)
Range("A12:I101").Copy 'copy values
If TypeName(filename) = "String" Then
sFilename = CStr(filename)
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("BG Load tab").Activate 'insert values
Range("A15:I104").PasteSpecial xlPasteValues
rval = MsgBox("Import Completed")
Application.CutCopyMode = False
actwb.Close
Else
' No file selected
rval = MsgBox("Import Cancelled: You did not selected a file to import reference data from.", vbExclamation, cAppTitle)
End If
ImportExit:
Application.ScreenUpdating = True
On Error Resume Next
Exit Sub
End Sub
Inputs from the source workbook: columns A to I, J to R
Outputs dropped in destination workbook: columns A to I and R to X,
Sub importcontact()
Dim actwb As Workbook
Dim LastRow As Long
Dim DestRow As Long
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim filename As Variant
Dim sFilename As String
Dim nbrMarkerRecs As Integer
Dim nbrProjectRecs As Integer
Dim nbrActivityRecs As Integer
Dim nbrWhatRecs As Integer
' Open File to load
filename = Application.GetOpenFilename(FileFilter:="Contact Import Files (*.txt; *.csv; *.xls; *.xlsx), *.txt;*.csv*.xls;*.xlsx", Title:="Import Contacts", MultiSelect:=False)
Set actwb = Workbooks.Open(filename)
Range("A12:I101").Copy 'copy values
If TypeName(filename) = "String" Then
sFilename = CStr(filename)
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("BG Load tab").Activate 'insert values
Range("A15:I104").PasteSpecial xlPasteValues
rval = MsgBox("Import Completed")
Application.CutCopyMode = False
actwb.Close
Else
' No file selected
rval = MsgBox("Import Cancelled: You did not selected a file to import reference data from.", vbExclamation, cAppTitle)
End If
ImportExit:
Application.ScreenUpdating = True
On Error Resume Next
Exit Sub
End Sub