PDA

View Full Version : Macro to export data from certain cells


kvinay_00
Aug 8, 2013, 07:27 PM
Hello,
I have a sheet (sheet1) which is used by different users many times to create some documents.
After creating the document, the data entered is deleted and new data is entered.
I want to capture information from certain cells each time to another sheet (sheet2) and data should remain there even if the data in sheet1 is deleted for new data entry.
The new data entered should get added to sheet2 below first data and so on.
I have attached a sample sheet.
Can anybody help?
Thanks in advance

JBeaucaire
Aug 16, 2013, 01:54 PM
1) Right-click on the EXPORT DATA button and select ASSIGN MACRO
2) Click on NEW
3) Paste in this macro:


Sub Rectangle3_Click()
Dim NR As Long

With Sheets("Sheet2")
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & NR).Value = Sheets("Sheet1").Range("B1").Value
.Range("B" & NR).Value = Sheets("Sheet1").Range("E1").Value
.Range("C" & NR).Value = Sheets("Sheet1").Range("E4").Value
End With

End Sub

4) Close the editor.

That should do it.

kvinay_00
Aug 20, 2013, 08:59 PM
Thank you so much JBeaucaire.
One more help -
The data is captured correctly. However, it allows duplicate entry of data.

country model chassis no
Kenya 10.75 1111
Sudan 10.85 2222
Kenya 10.75 1111
Sudan 10.85 2222

I want like if the data with a combination is already available in the rows above, it should not get copied again on new row.
Thanks

JBeaucaire
Aug 21, 2013, 11:52 PM
This should do it:


Option Explicit

Sub TransferData()
Dim NR As Long

With Sheets("Sheet2")
.AutoFilterMode = False
.Rows(1).AutoFilter 1, Sheets("Sheet1").Range("B1").Value
.Rows(1).AutoFilter 2, Sheets("Sheet1").Range("E1").Value
.Rows(1).AutoFilter 3, Sheets("Sheet1").Range("E4").Value
NR = .Range("A" & .Rows.Count).End(xlUp).Row
If NR = 1 Then
.AutoFilterMode = False
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & NR).Value = Sheets("Sheet1").Range("B1").Value
.Range("B" & NR).Value = Sheets("Sheet1").Range("E1").Value
.Range("C" & NR).Value = Sheets("Sheet1").Range("E4").Value
Else
.AutoFilterMode = False
MsgBox "This Data Exists in Sheet2 already"
End If
End With

End Sub