how to import excel files to sheet and add some values of userform

evinx

New Member
Joined
Jun 16, 2018
Messages
15
hello im trying to make a small system where i can import many files to 1 file with userforms ect

1. Source file
i want to import all data from source file to destination file
source file has data in Column A:J(on sheet1) and A:L(on sheet2)
and i want this imported to destination file (sheet4)D:N and D:P(sheet5)

2. Imported data has to add to First empty row

3. i need to add some values that are selected on the userform (ID) Column A (companyname) on Column B (clientname) On Column C that where selected on the userform

8f2Z8W5.jpg



Code:
Private Sub userform_activate()
Dim cell As Range
With Worksheets("Database Bedrijf")
For Each cell In .Range("B2:B1000" & .cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then Bedrijf.AddItem cell.Value
Next cell
End With
'''This declares the data type of the variable "LstRw'
Dim LstRw1 As Long
Dim LstRw2
'''This defines what the variable "LstRw' is to refer to. _
   (The row number of the last used cell in column A.)
LstRw1 = Blad8.cells(Rows.Count, "A").End(xlUp).Row
LstRw2 = Blad9.cells(Rows.Count, "A").End(xlUp).Row
'''This tells the textbox named ID to equal the value of the last used cell in Col.A after adding 1 to it.
ID1.Caption = Blad8.cells(LstRw1, "A").Value + 1
ID2.Caption = Blad9.cells(LstRw2, "A").Value + 1
End Sub
Private Sub Bedrijf_Change()
Dim RowMax As Integer
Dim wsh As Worksheet
Dim countExit As Integer
Dim CellCombo2 As String
Dim i As Integer

Set wsh = ThisWorkbook.Sheets("Database Klant")
RowMax = wsh.cells(Rows.Count, "B").End(xlUp).Row
'find last row of sheet in column A

Klant.Clear
'clear all value of comboBox2

With Klant
    For i = 2 To RowMax
        If wsh.cells(i, "B").Value = Bedrijf.Text Then
        'Just show value of mapping with column A
        .AddItem wsh.cells(i, "C").Value
        .List(.ListCount - 1, 3) = wsh.cells(i, "D").Value
        Else
        End If
    Next i
End With
End Sub
Private Sub CommandButton1_Click()
Call Import1
End Sub

Sub Import1()
    Const TARGET_COL As String = "C" 'adjust letter for your column
    Dim ws As Worksheet
    Dim selectedFile As Variant
    Dim cell As Range

    'Find the next blank cell in target column
    Set ws = ThisWorkbook.Worksheets("Sheet4")
    Set cell = ws.cells(ws.Rows.Count, TARGET_COL).End(xlUp).Offset(1)

    'Open the file dialog window
    selectedFile = Application.GetOpenFilename("Text Files (*.xlsx), *.xlsx")

    'Check if user hit cancel
    If selectedFile = False Then Exit Sub

    'Write the file name
    cell.Value = selectedFile

End Sub

i cant find any code to work with

thanks in advance
 
Last edited:

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
edit the code and got this working now thanks to all

Code:
Sub CopyOtherWorkbook_click()
If Bedrijf.Value = "Kies een Bedrijf" Then
MsgBox ("Kies een bedrijf voor je verder gaat.")
Exit Sub
End If
If Klant.Value = "Kies een Klant" Then
MsgBox ("Kies een klant voor je verder gaat.")
Exit Sub
End If
Ouimport.Hide
' Defines variables
Dim OpenFileName As String
Dim Wb1 As Workbook, Wb2 As Workbook
Dim ws As Worksheet
Dim RowMax As Integer
Dim lastrow As Integer
    Set ws = Worksheets("Database OU")
' Disables screen updating to reduce flicker
Application.ScreenUpdating = True
OpenFileName = Application.GetOpenFilename("klant,*.xlsx")
If OpenFileName = "" Then Exit Sub
' Sets Wb1 as the current (destination) workbook
    Set Wb1 = ThisWorkbook
' Sets Wb2 as the defined workbook and opens it - Update filepath / filename as required
    Set Wb2 = Workbooks.Open(OpenFileName)
    Wb2.Sheets("Buitendelen").Activate
' Sets LastRow as the first blank row of Wb1 Sheet1 based on column A (requires at least header if document is otherwise blank)
       
        RowMax = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
        lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
' With workbook 2
            With Wb2
' Activate it
                .Activate
    Application.ScreenUpdating = False
    Worksheets("Buitendelen").Activate
    Application.ScreenUpdating = True
' Input box to select the first cell in the range to copy from
                    startrng = InputBox("Wat is de eerste cel met waarde (bijvoorbeeld: A2)")
                    MsgBox ("Start Veld=" & startrng)
                    If startrng = "" Then Wb2.Close
                    If startrng = "" Then Exit Sub
' Input box to select the last cell in the range to copy from
                    endrng = InputBox("Wat is de Laatste cel met waarde (bijvoorbeeld: J8)")
                     MsgBox ("Eind Veld=" & endrng)
                    If endrng = "" Then Wb2.Close
                    If endrng = "" Then Exit Sub
                    
' Copy the specified range
                        Range(startrng, endrng).Copy
 
Upvote 0

Forum statistics

Threads
1,224,746
Messages
6,180,704
Members
452,994
Latest member
Janick

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top