macro to browse files then copy certain data from the selected fil

[Arran]

Hi,

I am really hoping that someone can help me with the following as I am
struggling:

I have a spreadsheet that I have created a button in; what I would like to
happen is that when the button is clicked it allows the user to browse and
select a file, then from the selected file I would like it to copy certain
cells and insert them in to the spreadsheet with the button on to the next
available row (not allowing a duplicate to be copied).

This is what I have come up with but it doesn't work:

Sub importdata()
Dim sfilename As String
sfilename = Application.GetOpenFilename
If sfilename <> "False" Then Workbooks.Open sfilename
Exit Sub

Dim A As Integer, ML As Integer
ML = 4 'MasterList Start Row
Dim bk As Workbook
Set bk = Worksheets("sfilename")

With bk.Worksheets("New Contract Set Up Form")
Do Until ThisWorkbook.Sheets("Data Base").Cells(ML, 3) = ""

If ThisWorkbook.Sheets("Data Base").Cells(ML, 3) = bk.Worksheets("New
Contract Set Up Form").Cells(7, 4) Then
bk.Worksheets("New Contract Set Up Form").Activate
Sheets("New Contract Set Up Form").Cells(4, 7).Copy _
ThisWorkbook.Sheets("Data Base").Cells(ML, 2)

ML = 5
Exit Do
End If
ML = ML + 1
If ThisWorkbook.Sheets("Data Base").Cells(ML, 3) = "" Then
bk.Worksheets("New Contract Set Up Form").Activate
Sheets("New Contract Set Up Form").Cells(4, 7).Copy _
ThisWorkbook.Sheets("Data Base").Cells(ML, 2)

End If

Loop

End Sub

Any help will be greatly appreciated

 

[Ron de Bruin]

See
http://www.rondebruin.nl/copy3.htm

 

[Dave Peterson]

I'm not quite sure what you're doing, but this compiled for me--but I didn't
test it.


Option Explicit
Sub importdata()
Dim sFilename As Variant 'could be a boolean (False)
'Dim A As Long
Dim MLRow As Long
Dim NewFormWkbk As Workbook
Dim NewFormWks As Worksheet
Dim DBWks As Worksheet

sFilename = Application.GetOpenFilename

If sFilename = False Then
Exit Sub
End If

'sFilename includes the drive, path and filename.
'You only include the filename when you use the
'workbooks() collection.
'But better is to just assign the variable
'when you open the workbook.
Set NewFormWkbk = Workbooks.Open(Filename:=sFilename)

Set NewFormWks = Nothing
On Error Resume Next
Set NewFormWks = NewFormWkbk.Worksheets("new contract set up form")
On Error GoTo 0

If NewFormWks Is Nothing Then
MsgBox "No sheet named: New Contract Set Up Form"
Exit Sub
End If

Set DBWks = ThisWorkbook.Worksheets("data base")

MLRow = 4 'MasterList Start Row

Do Until ThisWorkbook.Sheets("Data Base").Cells(MLRow, 3) = ""
If DBWks.Cells(MLRow, 3).Value = NewFormWks.Cells(7, 4).Value Then
NewFormWks.Cells(4, 7).Copy _
Destination:=DBWks.Cells(MLRow, 2)
MLRow = 5
Exit Do
End If
MLRow = MLRow + 1
If DBWks.Cells(MLRow, 3).Value = "" Then
NewFormWks.Cells(4, 7).Copy _
Destination:=DBWks.Cells(MLRow, 2)
End If
Loop

End Sub

I changed the name of some of your variables. It makes it easier for me to see
what's going on.

 

[Arran]

Hi Dave,

Thanks for your speedy response;

The code you have supplied is opening the selected workbook but it's not
copying the cells from the "New Contract Set Up Form" in to the "Data Base".

Anymore help will be very welcome.

Thanks

 

[Dave Peterson]

The code that does the copy|pasting is in this loop.

Do Until ThisWorkbook.Sheets("Data Base").Cells(MLRow, 3) = ""
If DBWks.Cells(MLRow, 3).Value = NewFormWks.Cells(7, 4).Value Then
NewFormWks.Cells(4, 7).Copy _
Destination:=DBWks.Cells(MLRow, 2)
MLRow = 5
Exit Do
End If
MLRow = MLRow + 1
If DBWks.Cells(MLRow, 3).Value = "" Then
NewFormWks.Cells(4, 7).Copy _
Destination:=DBWks.Cells(MLRow, 2)
End If
Loop

So if you step through it, you should be able to see what's happening. I bet
the data isn't what you expected in those cells.



And I missed a line of code that I wanted to change. It won't affect the way
the code works, but it will be consistent with the other changes.

Change this line:
Do Until ThisWorkbook.Sheets("Data Base").Cells(MLRow, 3) = ""
to
Do Until dbwks.Cells(MLRow, 3).value = ""

 

[Arran]

Hi Dave,

You were right, I had put the wrong cell references in.

I have now corrected these and it works perfectly.

This is greatly appreciated Dave.

Arran

 

[Arran]

Hi Dave,

Last question I promise;

I have been doing some testing and it is coping fine but it's copying the
original data's formates etc (some of the original cells are from dropdown
lists).

Is there anyway that it can copy and special paste the values and nothing
else?

Thanks in advance again.

Arran

 

[Dave Peterson]

You can use copy|paste special|Values:

NewFormWks.Cells(4, 7).Copy
DBWks.Cells(MLRow, 2).pastespecial paste:=xlpastevalues

Or you could just assign the value:
DBWks.Cells(MLRow, 2).value = NewFormWks.Cells(4, 7).Value

(you have a couple of lines that you'll have to change.)

Hi Dave,

Last question I promise;

I have been doing some testing and it is coping fine but it's copying the
original data's formates etc (some of the original cells are from dropdown
lists).

Is there anyway that it can copy and special paste the values and nothing
else?

Thanks in advance again.

Arran