Forum Discussion

Si_Slack's avatar
Si_Slack
Copper Contributor
Jul 01, 2020
Solved

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 t...
excel
Formulas and Functions
Macros and VBA
  • Charla74's avatar
    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

Si_Slack's avatar
Si_Slack
Copper Contributor
Jul 08, 2020

Hi Charla74,

 

Yes, I've downloaded the workbook a couple of times and tried it. It still only transfers 'Row 12' as it did previously. 

 

Also, the code in your message is the same code i had in the original workbook.  

 

Maybe the changes didn't save?

Charla74's avatar
Charla74
Iron Contributor
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

Resources