Results 1 to 4 of 4

Thread: Need to modify VBA code to import data from other workbook

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Junior Member
    Join Date
    Oct 2014
    Posts
    26
    Rep Power
    0

    Need to modify VBA code to import data from other workbook

    Hello guys,

    Need a little help to modify the below codes. Currently it copies data from the the source workbook if its column label matches what we have in ThisWorkbook.Worksheets("Sheet1").Range("B1:V1"). The below code requires the target workbook to have its column labels on A1 for it to work and this is where i'm having problem now. I want to export data from another workbook which has all its column labels on A5 to AH5 and i need to figure out how to edit the vba to capture and import data. Hope anyone can help on this. Thanks in advanced


    Code:
     Sub Export_RAW()
        Application.ScreenUpdating = False
        'Selection.AutoFilter
        With Application.FileDialog(msoFileDialogFilePicker)
            .AllowMultiSelect = False
            .ButtonName = "Import"
            .Filters.Clear
            '.Filters.Add "Excel Files", "*.csv"
            '.Filters.Add "CSV File", "*.xlsx"
            .Title = "Import Data"
            .Show
            If .SelectedItems.Count Then
                strFileSelected = .SelectedItems(1)
            Else
                'MsgBox "Cancelled by user!"
                Exit Sub 
            End If
        End With
     
     
        fncFileSelected = strFileSelected
    
        With Workbooks.Open(Filename:=fncFileSelected, ReadOnly:=True)
            .Sheets(1).Cells(1).End(xlToRight).Offset(, 2).Resize(, 21).Value = ThisWorkbook.Worksheets("Sheet1").Range("B1:V1").Value
            .Sheets(1).Cells(1).CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Sheets(1).Cells(1).End(xlToRight).Offset(, 2).CurrentRegion, Unique:=False
            With .Sheets(1).Cells(1).End(xlToRight).Offset(, 2).CurrentRegion
                ThisWorkbook.Worksheets("Sheet1").Range("B1:V1").Resize(.Rows.Count, .Columns.Count).Value = .Value
            ActiveWorkbook.RefreshAll
    
            End With
            Workbooks(.Name).Close 0
       
            
        End With
        
    
    End Sub
    Last edited by jeremiah_j2k; 06-07-2017 at 01:37 PM.

  2. #2
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Code:
    With Workbooks.Open(Filename:=fncFileSelected, ReadOnly:=True)
        .Sheets(1).Cells(5, 1).End(xlToRight).Offset(, 2).Resize(, 21).Value = ThisWorkbook.Worksheets("Sheet1").Range("B1:V1").Value
        Dim r  As Long, Rng As Range
        
        r = .Sheets(1).Range("a" & .Sheets(1).Rows.Count).End(3).Row
        Set Rng = .Sheets(1).Range("A5:U" & r)
        Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Sheets(1).Cells(5, 1).End(xlToRight).Offset(, 2).CurrentRegion, Unique:=False
        With Rng.Cells(1, 1).End(xlToRight).Offset(, 2).CurrentRegion
            ThisWorkbook.Worksheets("Sheet1").Range("B1:V1").Resize(.Rows.Count, .Columns.Count).Value = .Value
            ActiveWorkbook.RefreshAll
        End With
        Workbooks(.Name).Close 0
         
     End With

    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://www.youtube.com/watch?v=SIDLFRkUEIo&lc=UgzTF5vvB67Zbfs9qvx4AaABAg
    https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgxLtKj969oiIu7zNb94AaABAg
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg
    https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgzMCQUIQgrbec400jl4AaABAg
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugx12mI-a39T41NaZ8F4AaABAg.9iDQqIP56NV9iFD0AkeeJG
    https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugxa2VYHMWJWXA6QI294AaABAg. 9irLgSdeU3r9itU7zdnWHw
    https://www.youtube.com/watch?v=tPRv-ATUBe4&lc=UgzFkoI0n_BxwnwVMcZ4AaABAg
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9htG01cKBzX
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg. 9ht16tzryC49htJ6TpIOXR
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwMKwGZpDjv7vi7pCx4AaABAg
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg. 9ht16tzryC49htOKs4jh3M
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxVW-am20rQ5GFuJ9F4AaABAg
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 10-24-2023 at 03:00 PM.
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  3. #3
    Junior Member
    Join Date
    Oct 2014
    Posts
    26
    Rep Power
    0
    Thanks admin for immediate response. its working fine now. I appreciate your help
    Last edited by jeremiah_j2k; 06-07-2017 at 05:36 PM.

  4. #4
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    You are welcome
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

Similar Threads

  1. Need help to modify the VBA code
    By jeremiah_j2k in forum Excel Help
    Replies: 8
    Last Post: 10-23-2014, 01:44 PM
  2. Replies: 4
    Last Post: 04-19-2014, 05:08 PM
  3. Replies: 1
    Last Post: 05-09-2013, 08:56 AM
  4. Replies: 7
    Last Post: 05-08-2013, 07:12 PM
  5. VBA Code to Open Workbook and copy data
    By Howardc in forum Excel Help
    Replies: 16
    Last Post: 08-15-2012, 06:58 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •