VBA to Transfer (Certain) Data from One Workbook to Another

nc_waggoner

New Member
Joined
Sep 2, 2016
Messages
21
PLEASE HELP! I will describe this as detailed as possible.

GOAL: To auto-transfer data (criteria based/no blanks) from an online-based Sharepoint file to a separate workbook for analysis

From (Source) File = “LabData.xlsx” located online at http://sharepoint.com/Labs/LabData (made up)

To (Analysis) File = “LabData Analysis.xlsx”

THINGS TO CONSIDER:

  1. Due to user/input error, only valid data should be transferred. No blanks with the best method being a named range…in the below example only transfer rows where the “DIFF” is between -3 and 3.
  2. Preferred, but optional, to auto-open the source file from online so that I can do everything locally.

DATA EXAMPLE: (In the below example, samples 1, 6, and 10 should be omitted from the transfer for not meeting the criteria )

[TABLE="******* 506"]
<tbody>[TR]
[TD]DATE[/TD]
[TD]SAMPLE[/TD]
[TD]TANK[/TD]
[TD]TEST 1[/TD]
[TD]SAMPLE WT[/TD]
[TD]TEST 2[/TD]
[TD]DIFF[/TD]
[/TR]
[TR]
[TD]8/1/2016[/TD]
[TD]1[/TD]
[TD]30[/TD]
[TD]35[/TD]
[TD]1.25[/TD]
[TD]31.5[/TD]
[TD]3.5[/TD]
[/TR]
[TR]
[TD]8/2/2016[/TD]
[TD]2[/TD]
[TD]40[/TD]
[TD]30.5[/TD]
[TD]2[/TD]
[TD]33[/TD]
[TD]-2.5[/TD]
[/TR]
[TR]
[TD]8/3/2016[/TD]
[TD]3[/TD]
[TD]50[/TD]
[TD]31.5[/TD]
[TD]1.75[/TD]
[TD]32[/TD]
[TD]-0.5[/TD]
[/TR]
[TR]
[TD]8/4/2016[/TD]
[TD]4[/TD]
[TD]1[/TD]
[TD]32.5[/TD]
[TD]1[/TD]
[TD]34[/TD]
[TD]-1.5[/TD]
[/TR]
[TR]
[TD]8/5/2016[/TD]
[TD]5[/TD]
[TD]10[/TD]
[TD]33.5[/TD]
[TD]2[/TD]
[TD]33[/TD]
[TD]0.5[/TD]
[/TR]
[TR]
[TD]8/6/2016[/TD]
[TD]6[/TD]
[TD]1[/TD]
[TD]30.5[/TD]
[TD]1[/TD]
[TD][/TD]
[TD]30.5[/TD]
[/TR]
[TR]
[TD]8/7/2016[/TD]
[TD]7[/TD]
[TD]10[/TD]
[TD]31.5[/TD]
[TD]2[/TD]
[TD]33[/TD]
[TD]-1.5[/TD]
[/TR]
[TR]
[TD]8/8/2016[/TD]
[TD]8[/TD]
[TD]20[/TD]
[TD]32.5[/TD]
[TD]1.5[/TD]
[TD]32[/TD]
[TD]0.5[/TD]
[/TR]
[TR]
[TD]8/9/2016[/TD]
[TD]9[/TD]
[TD]30[/TD]
[TD]33.5[/TD]
[TD]1.25[/TD]
[TD]34[/TD]
[TD]-0.5[/TD]
[/TR]
[TR]
[TD]8/10/2016[/TD]
[TD]10[/TD]
[TD]40[/TD]
[TD]30.5[/TD]
[TD]1[/TD]
[TD]34[/TD]
[TD]-3.5[/TD]
[/TR]
</tbody><colgroup><col><col><col><col><col><col span="2"></colgroup>[/TABLE]
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Try this code:
Code:
Option Explicit


Sub MoveData()
'Copy to Master Spreadsheet
Dim lr As Long
Dim lrC As Long
Dim wbTarget As Workbook 'Master
Dim wbThis As Workbook  'Current Open Workbook
Dim strName As String 'Name for source sheet/target workbook
Dim thePath As String  'Path for Master Spreadsheet
Dim i As Long


    Application.ScreenUpdating = False


'set the current active workbook
    Set wbThis = ActiveWorkbook
'set the target workbook name
    strName = "labdataanalysis"
'set the path to the Comments Spreadsheet
'change thepath to your path for the file
    thePath = "C:\Users\Alan\Desktop\"
'open Master Spreadsheet
    Set wbTarget = Workbooks.Open(thePath & strName & ".xlsx")
'Activate the Target Workbook
    wbTarget.Activate
'activate source workbook
    wbThis.Activate
'find the last row in column A to determine the range to copy
    lr = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
'clear any thing on the clipboard to mazimize available memory
    Application.CutCopyMode = False
'Determine rows to copy
    For i = 1 To lr
    'Find the last row in the target workbook
    lrC = wbTarget.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    If wbThis.Sheets("Sheet1").Range("G" & i) >= -3 And wbThis.Sheets("Sheet1").Range("G" & i) <= 3 Then
    Range("G" & i).EntireRow.Copy wbTarget.Sheets("sheet1").Range("A" & lrC + 1)
    End If
    Next i
'Clear the clipboard
    Application.CutCopyMode = False
    wbTarget.Save
    wbTarget.Close
    wbThis.Activate
    Application.ScreenUpdating = True
         
'clear memory
    Set wbTarget = Nothing
    Set wbThis = Nothing
    MsgBox "Data Transferred"
End Sub

Put the code in the source file labdata and give it an .xlsm extention. Note that you will have to change thepath variable to your path. I have not worked with sharepoint so I am unsure of what that would be. I tested using just my desktop as a target. Also check the spelling of both files to ensure that the code and the files are exactly the same. ie. spaces and capitalization
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,874
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top