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...

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

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
- 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
    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

Forum Discussion

VBA - Transferring select data to new spreadsheet