Import VBA values

Question

Good evening everyone,

I have a VBA problem in copying only the values of another file example c: \ Example.xlsx (sheet name "Sheet1") and I have to copy the values from A2: T20.

Then I have to paste in another file Invoice.xlsx on the “Invoice” folder on A2.

the file must run upon opening.

Thanks for your help

Answer 1

An example how to change the main routine is below, I leave you to program the rest of the SELECT CASE statement.

Andreas.

Sub Import()

Dim Wb As Workbook

Dim Header As Range, Source As Range

Dim Data

Set Wb = OtherWorkbook

If Wb Is Nothing Then

MsgBox "Open the file that contains the data to be imported.", vbExclamation 

Exit Sub 

End If

With Wb.ActiveSheet

'Check each header in here 

For Each Header In Range("A1").CurrentRegion.Rows(1).Cells 

  'Search in the source 

  Set Source = .Rows(1).Find(Header, LookIn:=xlValues, LookAt:=xlWhole) 

'!!AK-13.12.21 begin

  'Found? 

  If Not Source Is Nothing Then 

    'Where is the header we search for 

    Select Case Header.Address(0, 0) 

      Case "A1" 

        'The matching header is here 

        Set Source = .Range("E1") 

      Case "B1" 

        'The matching header is here 

        Set Source = .Range("F1") 

    End Select 

  End If 

'!!AK-13.12.21 end

  'Found? 

  If Not Source Is Nothing Then 

    'Read the data 

    Data = .Range(Source.Offset(1), Source.Offset(.Rows.Count - 1).End(xlUp)).Value 

    'Write into our file 

    Header.Offset(1).Resize(UBound(Data)).Value = Data 

  End If 

Next 

End With

End Sub

Answer 2

Sub Auto_Open()
Dim wbSource As Workbook, wbDest As Workbook
Dim InvoicePath As String

'Get the path from the active sheet
InvoicePath = Range("A2")
'Be sure we have a backslash at the end
If Right(InvoicePath, 1) <> "" Then InvoicePath = InvoicePath & ""

'Open both files
Set wbSource = Workbooks.Open("C:\example.xlsx")
Set wbDest = Workbooks.Open(InvoicePath & "invoice.xlsx")

'Copy & paste
wbSource.Sheets("Sheet1").Range("A2:T20").Copy
wbDest.ActiveSheet.Range("A1").PasteSpecial xlPasteValues

'Done
Application.CutCopyMode = False
End Sub