Need to modify VBA code to import data from other workbook

**jeremiah_j2k** · 06-07-2017, 01:20 PM

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

**Admin** · 06-07-2017, 04:52 PM

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