VBA - Transferring select data to new spreadsheet

Hi,

I've found this VBA code to transfer select data (Row 12 only) from one file (Source file) to another (Transfer Data file). Obviously, this is very limited in its uses, therefore i would like to adapt so that rather than transferring data from only Row 12 it transfers rows with 'Yes' in column A.

Currently, the VBA opens, adds the data to the 'Transfer Data' file on the next empty line, saves and closes the document. These features i'd like to remain.

Private Sub CommandButton1_Click()

Dim wb As Workbook
ThisWorkbook.Worksheets("Source").Rows(12).Select
Selection.Copy

Set wb = Workbooks.Open("C:\Users\Sslack\Desktop\Transfer Data.xlsx")
wb.Worksheets("data").Activate

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

ActiveSheet.Cells(lastrow + 1, 1).Select

ActiveSheet.Paste

ActiveWorkbook.Save

ActiveWorkbook.Close savechanges = True

Set wb = Nothing

ThisWorkbook.Worksheets("Source").Activate
ThisWorkbook.Worksheets("Source").Cells(1, 1).Select

Application.CutCopyMode = False

End Sub

If anyone can assist it would be a huge help.

Thanks

Simon

Source.xlsm23 KB

Transfer Data.xlsx9 KB

excel

Formulas and Functions

Macros and VBA

Charla74
Jul 08, 2020
Si_Slack

Oops! You're right, it is the same as the original, not sure how I managed that....
So, below should be the alternative code - try this and let me know how it works out for you.

Sub Export_Details()
Dim wb As Workbook
Dim rTable As Range
ThisWorkbook.Worksheets("Source").Activate
ActiveSheet.UsedRange.AutoFilter Field:=1, Criteria1:="Yes"

Set rTable = Sheets("Source").AutoFilter.Range
Set rTable = rTable.Resize(rTable.Rows.Count - 1)
Set rTable = rTable.Offset(1)
rTable.Copy
Set wb = Workbooks.Open("C:\Users\Sslack\Desktop\Transfer Data.xlsm")
wb.Worksheets("data").Activate
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Cells(lastrow + 1, 1).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close savechanges = True
Set wb = Nothing
ThisWorkbook.Worksheets("Source").Activate
Application.CutCopyMode = False
ActiveSheet.AutoFilterMode = False
ThisWorkbook.Worksheets("Source").Cells(1, 1).Select
End Sub

6 Replies

Charla74
Iron Contributor
Jul 02, 2020
Si_Slack
Hi,

Please try the updated macro in the attached file. I used autofilter to select only data with 'Yes' in column A.

As your code saves the workbook before closing, I'd suggest saving a copy of both files to a new location (as a backup) before running the macro.
Source.xlsm25 KB
- Si_Slack
  Copper Contributor
  Jul 06, 2020
  
  Hi Charla74,
  
  Thank you for the response.
  
  I've just tried the macro and it returns the same result (Row 12). Maybe i've missed something? I've check the code and it looks to be the same too.
  
  Thanks
  - Charla74
    Iron Contributor
    Jul 06, 2020
    Hi Si_Slack
    
    Did you download the file from my post? Anyway, the revised code should look as follows:
    
    Private Sub CommandButton1_Click()
    Dim wb As Workbook
    ThisWorkbook.Worksheets("Source").Rows(12).Select
    Selection.Copy
    Set wb = Workbooks.Open("C:\Users\Sslack\Desktop\Transfer Data.xlsx")
    wb.Worksheets("data").Activate
    lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    ActiveSheet.Cells(lastrow + 1, 1).Select
    ActiveSheet.Paste
    ActiveWorkbook.Save
    ActiveWorkbook.Close savechanges = True
    Set wb = Nothing
    ThisWorkbook.Worksheets("Source").Activate
    ThisWorkbook.Worksheets("Source").Cells(1, 1).Select
    Application.CutCopyMode = False
    End Sub

Forum Discussion

VBA - Transferring select data to new spreadsheet