VBA Import Data Question

[Glasgowsmile]

Hello!

Currently my spreadsheet uses the following code, which I just found off another site. It's great but I need to advance it a bit and don't know how.

I would like to be able to select the document but have it automatically import a specific range (which always remains the same) within the spreadsheet and then place it in a specific spot on my current spreadsheet.

Where do I start? lol

Sub ImportDatafromotherworksheet()    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook
    Dim rngSourceRange As Range
    Dim rngDestination As Range
    Set wkbCrntWorkBook = ActiveWorkbook
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel 2007-13", "*.xlsx; *.xls; *.xlsm; *.xlsa"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A1", Type:=8)
            wkbCrntWorkBook.Activate
            Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8)
            rngSourceRange.Copy rngDestination
            rngDestination.CurrentRegion.EntireColumn.AutoFit
            wkbSourceBook.Close False
        End If
    End With
End Sub

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub ImportDatafromotherworksheet()
   Dim wkbCrntWorkBook As Workbook
   Dim wkbSourceBook As Workbook
   Set wkbCrntWorkBook = ActiveWorkbook
   With Application.FileDialog(msoFileDialogOpen)
      .Filters.Clear
      .Filters.Add "Excel 2007-13", "*.xlsx; *.xls; *.xlsm; *.xlsa"
      .AllowMultiSelect = False
      .Show
      If .SelectedItems.count > 0 Then
         Workbooks.Open .SelectedItems(1)
         Set wkbSourceBook = ActiveWorkbook
         Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Range("[COLOR=#ff0000]A1:Z40[/COLOR]").Copy wkbCrntWorkBook.Sheets("[COLOR=#0000ff]Sheet1[/COLOR]").Range("[COLOR=#0000ff]A1[/COLOR]")
         wkbCrntWorkBook.Sheets("[COLOR=#0000ff]Sheet1[/COLOR]").Range("[COLOR=#0000ff]A1[/COLOR]").CurrentRegion.EntireColumn.AutoFit
         wkbSourceBook.Close False
      End If
   End With
End Sub

Change values in red to match your source & values in blue to match the destination

 

[Glasgowsmile]

Thanks!

After reviewing, I realized I have a few other issues here.

I need to make multiple selections during the import and paste those in multiple destination - do I just create a line of code for each selection/destination?

Additionally, the destinations actually need to be more dynamic. I would need it to look at the cell to the left - if blank then put data there but if it has data then go 1 cell to the right. Is that possible?

 

[Fluff]

Maybe something like

Sub ImportDatafromotherworksheet()
   Dim wkbCrntWorkBook As Workbook
   Dim wkbSourceBook As Workbook
   Dim Rng As Range
   Set wkbCrntWorkBook = ActiveWorkbook
   
   With Application.FileDialog(msoFileDialogOpen)
      .Filters.Clear
      .Filters.Add "Excel 2007-13", "*.xlsx; *.xls; *.xlsm; *.xlsa"
      .AllowMultiSelect = False
      .Show
      If .SelectedItems.count > 0 Then
         Workbooks.Open .SelectedItems(1)
         Set wkbSourceBook = ActiveWorkbook
         If wkbCrntWorkBook.Sheets("Sheet1").Range("A1") = "" Then
            Set Rng = wkbCrntWorkBook.Sheets("Sheet1").Range("B1")
         Else
            Set Rng = wkbCrntWorkBook.Sheets("Sheet1").Range("C1")
         End If
         Sheets("Sheet1").Range("A1:Z40").Copy Rng
         Rng.CurrentRegion.EntireColumn.AutoFit
         wkbSourceBook.Close False
      End If
   End With
End Sub

 

[Glasgowsmile]

Thanks,

This is what I've got so far.

As it stands now, if C30 is blank then it puts the data there but if it has information then it moves over 1 due to the offset. Problem is - I need it more dynamic. Next import I would need it to reference C31 instead of C30 and then move the data over to the right one.

Additionally, I need to pull 3 separate cells each import and they go to 3 different desitnations. I've tried adding commas but it doesn't seem to like that method.

Sub ImportDatafromotherworksheet()   Dim wkbCrntWorkBook As Workbook
   Dim wkbSourceBook As Workbook
   Dim Rng As Range
   Set wkbCrntWorkBook = ActiveWorkbook
   
   With Application.FileDialog(msoFileDialogOpen)
      .Filters.Clear
      .Filters.Add "Excel 2007-13", "*.xlsx; *.xls; *.xlsm; *.xlsa"
      .AllowMultiSelect = False
      .Show
      If .SelectedItems.Count > 0 Then
         Workbooks.Open .SelectedItems(1)
         Set wkbSourceBook = ActiveWorkbook
         If wkbCrntWorkBook.Sheets("HotelData").Range("C30") = "" Then
            Set Rng = wkbCrntWorkBook.Sheets("HotelData").Range("C30")
         Else
            Set Rng = wkbCrntWorkBook.Sheets("HotelData").Range.Offset(0, 1)
         End If
         Sheets("Glance").Range("I11").Copy Rng
         Rng.CurrentRegion.EntireColumn.AutoFit
         wkbSourceBook.Close False
      End If
   End With
End Sub

 

[Fluff]

If you want to put the data into C30 then D30, E30 etc try

Sub ImportDatafromotherworksheet()
   Dim wkbCrntWorkBook As Workbook
   Dim wkbSourceBook As Workbook
   Dim Rng As Range
   Dim Cols As Long
   
   Set wkbCrntWorkBook = ActiveWorkbook
   
   With Application.FileDialog(msoFileDialogOpen)
      .Filters.Clear
      .Filters.Add "Excel 2007-13", "*.xlsx; *.xls; *.xlsm; *.xlsa"
      .AllowMultiSelect = False
      .Show
      If .SelectedItems.count > 0 Then
         Workbooks.Open .SelectedItems(1)
         Set wkbSourceBook = ActiveWorkbook
         Cols = Application.CountA(wkbCrntWorkBook.Sheets("HotelData").Range("C30:[COLOR=#ff0000]H30[/COLOR]")) + 3
         Sheets("Glance").Range("I11").Copy wkbCrntWorkBook.Sheets("HotelData").Cells(30, Cols)
         wkbCrntWorkBook.Sheets("HotelData").Cells(30, Cols).CurrentRegion.EntireColumn.AutoFit
         wkbSourceBook.Close False
      End If
   End With
End Sub

Where H30 is the last cell you'd want to fill.

 

[Glasgowsmile]

This covers half of the issue, thanks!

so I'm now able to pull the correct data I want but I can't get the data to go where I need it to.

I want it to pull I11, N11, and S11 from Glance and put it into C30, R30, AG30 respectively and keep moving to the right side each time I import the data.

Sub ImportDatafromotherworksheet()   Dim wkbCrntWorkBook As Workbook
   Dim wkbSourceBook As Workbook
   Dim Rng As Range
   Dim Cols As Long
   
   Set wkbCrntWorkBook = ActiveWorkbook
   
   With Application.FileDialog(msoFileDialogOpen)
      .Filters.Clear
      .Filters.Add "Excel 2007-13", "*.xlsx; *.xls; *.xlsm; *.xlsa"
      .AllowMultiSelect = False
      .Show
      If .SelectedItems.Count > 0 Then
         Workbooks.Open .SelectedItems(1)
         Set wkbSourceBook = ActiveWorkbook
         Cols = Application.CountA(wkbCrntWorkBook.Sheets("HotelData").Range("C30,R30,AG30")) + 3
         Sheets("Glance").Range("I11,N11,S11").Copy wkbCrntWorkBook.Sheets("HotelData").Cells(30, Cols)
         wkbCrntWorkBook.Sheets("HotelData").Cells(30, Cols).CurrentRegion.EntireColumn.AutoFit
         wkbSourceBook.Close False
      End If
   End With
End Sub

 

[Fluff]

For the I11/C30 value what is the last col you would want to copy that data to?

 

[Glasgowsmile]

I11 should post between C30:N30
N11 between R30:AC30
S11 between AG30:AR30

Hope that helps!

 

[Fluff]

Try

Cols = Application.CountA(wkbCrntWorkBook.Sheets("HotelData").Range("C30:N30")) + 3
Sheets("Glance").Range("I11").Copy wkbCrntWorkBook.Sheets("HotelData").Cells(30, Cols)
wkbCrntWorkBook.Sheets("HotelData").Cells(30, Cols).CurrentRegion.EntireColumn.AutoFit
Cols = Application.CountA(wkbCrntWorkBook.Sheets("HotelData").Range("R30:AC30")) + 18
Sheets("Glance").Range("N11").Copy wkbCrntWorkBook.Sheets("HotelData").Cells(30, Cols)
wkbCrntWorkBook.Sheets("HotelData").Cells(30, Cols).CurrentRegion.EntireColumn.AutoFit
Cols = Application.CountA(wkbCrntWorkBook.Sheets("HotelData").Range("AG30:AR30")) + [COLOR=#ff0000]??[/COLOR]
Sheets("Glance").Range("S11").Copy wkbCrntWorkBook.Sheets("HotelData").Cells(30, Cols)
wkbCrntWorkBook.Sheets("HotelData").Cells(30, Cols).CurrentRegion.EntireColumn.AutoFit

replace the ?? with whatever column number AG is