VBA code to import specific data from one excel workbook to another excel workbook

[lcrumb]

I am trying to code a macro to import selected data from one excel workbook into another excel workbook.

I'm using the following code:

Sub IMPORT_DATA()
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 2002-03", "*.xls", 1
.Filters.Add "Excel 2007", "*.xlsx; *.xlsm; *.xlsa", 2
.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:="C:C,D:D,K:K,L:L,P:P,Q:Q,S:S,AC:AC", Type:=8)
Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="C:C,D:D,K:K,L:L,P:P,Q:Q,S:S,AC:AC", Type:=8)
rngSourceRange.Copy rngDestination
rngDestination.CurrentRegion.EntireSelection.AutoFit
wkbSourceBook.Close False

End If
End With
End Sub



The issue I'm having is when I run the code, it doesn't select the data that I specified in the red text above. How can I select specific columns of data and copy paste into new excel workbook?

 

[Rosen]

The InputBox returns a string, not a range. Try this (just remember to backup your work before you try this as I haven't tested it).

Sub IMPORT_DATA()
     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 2002-03", "*.xls", 1
         .Filters.Add "Excel 2007", "*.xlsx; *.xlsm; *.xlsa", 2
         .AllowMultiSelect = False
         .Show
        
         If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            Set rngSourceRange = wkbSourceBook.Sheets(1).Range(Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="C:C,D:D,K:K,L:L,P:P,Q:Q,S:S,AC:AC", Type:=8))
            Set rngDestination = wkbCrntWrkbBook.Sheets(1).Range(Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="C:C,D:D,K:K,L:L,P:P,Q:Q,S:S,AC:AC", Type:=8))
            rngSourceRange.Copy rngDestination
            rngDestination.CurrentRegion.EntireSelection.AutoFit
            wkbSourceBook.Close False
         End If
     End With
 End Sub

Hope this helps!

 

[lcrumb]

Rosen, I still get an error message when running it. Is there a simpler VBA code to import certain columns from one workbook to a new workbook?

Thanks for your help!

 

[Kentetsu]

Here is some coding I put together a while back. It opens workbooks, copies/pastes, formats data, etc. There may be some tidbits in here that you can reuse, sorry I don't have the time to pull specific pieces out for you. I should note however, that although this code works fine, it might not be the best example of good coding. I've only been playing around with VBA since this Spring. Hope this helps:

Private Sub CommandButton1_Click()

Dim datesearch As Date
Dim wb As Workbook
Dim wbnewlog As Workbook
Dim w As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False

            datesearch = DTPicker1.Value
            Range("F25") = datesearch
                        Range("f25").Copy
                        Range("f26").PasteSpecial Paste:=xlPasteValues, Transpose:=False
                        Application.CutCopyMode = False
                        
            'Open Log.XLSM to get data
            
            Set wb = Workbooks.Open(Filename:="J:\ZZ  PII Ovens\Batch Ovens PC\Oven Logs Database\Log2.xlsm")
            With wb.Worksheets("Log")
            .Unprotect Password:="pass"
            'End With
            'Set w = Worksheets("Log")
            'With wb.Worksheets("Log")
            'Filter by date
            .Cells.AutoFilter field:=1, Criteria1:=datesearch, _
             Operator:=xlOr, Criteria2:="Important"
             ActiveWorkbook.Worksheets("Log").Copy
             End With
                     
                            'Identify new Workbook
                          Set wbnewlog = ActiveWorkbook
            Windows("Log2.xlsm").Activate
            With wb.Worksheets("Log")
            '.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="five"
                        With .Parent
                        .Saved = True
                        .Close
                        End With
                        End With
                        
                        With wbnewlog.Worksheets("Log")
                        Worksheets.Add().Name = "PII Yields"
                                    Application.Goto wbnewlog.Worksheets("Log").Range("A1"), True
                        End With
                        
                        'With the new copy, copy all then paste as values
                            Worksheets("Log").UsedRange.SpecialCells(xlCellTypeVisible).Copy
                            With wbnewlog.Worksheets("PII Yields")
                            .Range("a1").PasteSpecial Paste:=8
                            .Range("a1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=False
                            
                            Sheets("Log").Delete
                                    
                                    .Range("B1") = "SKU"
                                    .Range("C1") = "Rks"
                                    .Range("D1") = "Ovn"
                                    .Range("E1") = "Sok"
                                    .Range("F1") = "Clean"
                                    .Range("G1") = "S&D"
                                    .Range("H1") = "Lweight"
                                    .Range("I1") = "Card1"
                                    .Range("J1") = "Serial1"
                                    .Range("M1") = "Card2"
                                    .Range("N1") = "Shwr"
                                    .Range("O1") = "UnDate"
                                    .Range("Q1") = "CWt1"
                                    .Range("R1") = "Rec"
                                    .Range("S1") = "CWt2"
                                    .Range("T1") = "CkYield"
                                    .Range("U1") = "CstYield"
                                    .Range("V1") = "Cook Yield Vs. Costing"
                                    
                                    'Cook time comparison
                                    .Range("W1") = "Exp Time"
                                    .Range("X1") = "Actual Vs. Expected Cook Time"
                                    .Range("Y1") = "Ck Time"
                                    
                                    
                                .Range("B:E, G:J, L:O, P:R, S:S, T:U, X:Y").ColumnWidth = 6
                                .Range("K:K").ColumnWidth = 35
                                .Range("P:P").ColumnWidth = 20
                                
                                
                    'If no activity to report, then close workbooks and produce messagebox
                    If .Range("C2").Value = "" Then
                        MsgBox "No Acivity for this Date"
                        wbnewlog.Worksheets("PII Yields").Activate
                        ActiveWorkbook.Close False
                        Exit Sub
                    End If
                        End With
                            
                                
                           'Format as Table
                            Application.Goto wbnewlog.Worksheets("PII Yields").Range("A1"), True
                            With ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.Range("A1").CurrentRegion, , xlYes)
                            .Name = "Table1"
                            '.TableStyle = "TableStylelight15"
                            End With
                            
                            
            Set wb = Workbooks.Open(Filename:="J:\ZZ  PII Ovens\Batch Ovens PC\Oven Logs Database\Yield Template.xlsx")
            With wb.Worksheets("YieldCalc")
            .Unprotect Password:="five"
            End With
                                    
                        'Copy Yield Data
                        With wb.Worksheets("YieldCalc")
                            .Range("I1:K121").Copy
                            End With
                            
                        'Paste Time Data then hide
                        Application.Goto wbnewlog.Worksheets("PII Yields").Range("AJ1"), True
                        With wbnewlog.Worksheets("PII Yields")
                        ActiveSheet.Paste
                        .Range("AJ:AL").EntireColumn.Hidden = True
                        
                        With wb.Worksheets("YieldCalc")
                            .Range("E1:F490").Copy
                            End With
                            
                        'Paste Yield Data then hide
                        Application.Goto wbnewlog.Worksheets("PII Yields").Range("AF1"), True
                        With wbnewlog.Worksheets("PII Yields")
                        ActiveSheet.Paste
                        .Range("AF:AG").EntireColumn.Hidden = True
                        
                        
                        '.Range("E:G, I:J, L:M, Q:R, U:U, W:W, Y:Y").EntireColumn.Hidden = True
                        
                        Windows("Yield Template.xlsx").Activate
                        With wb.Worksheets("YieldCalc")
                        .Protect Password:="pass"
                        
                                    With .Parent
                                    .Saved = True
                                    .Close
                                    End With
                            End With
                        
                        'Start IF statement here to enter "No Activity" if Lweight = ""
        'If Range("A2") ="""" Then
        '        cell Value
        '.Range("S2") = "=IF([@Lweight]="""","" "")"
        'End IF statement
        
             
'                    If .Range("C2") < 0 Then
'                    MsgBox "No Activity for this Date"
'                    Exit Sub
'                    End If
                        
                        
                        'Add Formulas
        .Range("T2") = "=IF([@UnDate]="""","""",(S2/H2))"                           'Yield Calculation
        .Range("U2") = "=VLOOKUP([@SKU],$AF$1:$AG$490,2,FALSE)"                     'Look up costing yield
        .Range("V2") = "=IF([@UnDate]="""",""Cooking"",[@[CkYield]]-[@[CstYield]])" 'Costing yield comparison
        .Range("W2") = "=VLOOKUP([@SKU],$AJ$1:$AL$490,2,FALSE)"                     'Look up cook time
        .Range("X2") = "=IF([@UnDate]="""",""Cooking"",[@[Ck Time]]-[@[Exp Time]])" 'Time comparison calculation
        '.Range("X2") = "=IF([@Date]="""",""No Activity"",[@[Ck Time]]-[@[Exp Time]])"
        .Range("V2") = "=IF([@UnDate]="""",""Cooking"",[@[CkYield]]-[@[CstYield]])"
        .Range("Y2") = "=((MOD($O2-$A2,1)*24)*60)-N2"                               'Format time
        .Range("S2") = "=IF(ISNA($Q2),$H2,IF(OR($Q2=0,$Q2=""""),$H2,$Q2))"          'Set the cook weight
        '.Range("V2") = "=IF([@Date]="""",""No Activity"",[@[CkYield]]-[@[CstYield]])"
        '.Range("W2") = "=IF([@Exp Time]=""#N/A"","" "",)"
         .Range("E:G, I:J, L:M, Q:R, U:U, W:W, Y:Y").EntireColumn.Hidden = True
                                        
        
                    
                                            
                        .Range("W:Y").Select
                        Selection.NumberFormat = "0"
                        
                       .Range("T:V").NumberFormat = "0.00%"                    '.Select
                     '  Selection.NumberFormat = "0.00%"
                       .Range("V:V, X:X").ColumnWidth = 40
                        
                        .Range("K:K, P:P").WrapText = True      '.Select
'                        With Selection
'                        Selection.WrapText = True
'                        End With
                        
                        .Range("O:O").NumberFormat = "mm-dd-yy"
                    
                                                                       
                        'Create a data bar with default behavior.
                        .Range("V:V").Select
                        End With
    With Selection
    With .FormatConditions.AddDatabar
        .ShowValue = True
        .SetFirstPriority
        .MinPoint.Modify newtype:=xlConditionValueLowestValue, NewValue:=-1
        .MaxPoint.Modify newtype:=xlConditionValueHighestValue, NewValue:=1
        'Selection.FormatConditions(1).BarFillType = xlDataBarFillSolid
    Selection.FormatConditions(1).Direction = xlContext
    Selection.FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
    'Selection.FormatConditions(1).BarBorder.Type = xlDataBarBorderNone
    Selection.FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
    End With
    End With
    With Selection.FormatConditions(1).AxisColor
        .Color = 0
        .TintAndShade = 0
            With Selection.FormatConditions(1).BarColor
        .Color = 8700771#
        .TintAndShade = 0
    End With
        End With
        With Selection.FormatConditions(1).NegativeBarFormat.Color
        .Color = 255
        .TintAndShade = 0
          End With
          
          .Range("X:X").Select
                        End With
    With Selection
    With .FormatConditions.AddDatabar
        .ShowValue = True
        .SetFirstPriority
        .MinPoint.Modify newtype:=xlConditionValueLowestValue, NewValue:=-1
        .MaxPoint.Modify newtype:=xlConditionValueHighestValue, NewValue:=1
        'Selection.FormatConditions(1).BarFillType = xlDataBarFillSolid
    Selection.FormatConditions(1).Direction = xlContext
    Selection.FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
    'Selection.FormatConditions(1).BarBorder.Type = xlDataBarBorderNone
    Selection.FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
    End With
    End With
    With Selection.FormatConditions(1).AxisColor
        .Color = 0
        .TintAndShade = 0
            With Selection.FormatConditions(1).BarColor
        .Color = 255
        .TintAndShade = 0
    End With
        End With
        With Selection.FormatConditions(1).NegativeBarFormat.Color
        .Color = 8700771
        .TintAndShade = 0
          End With
                                                                               
                               'Format print to one page
                                With ActiveSheet.PageSetup
                                .Orientation = xlLandscape
                                .Zoom = False
                                .FitToPagesTall = 1
                                .FitToPagesWide = 1
                                 End With
                                                   
                    'Return Application Settings to default & Close this spreadsheet
                    Application.Goto wbnewlog.Worksheets("PII Yields").Range("A1"), True
                    Windows("PII Cook Time & Yield Report.xlsm").Activate
                    Application.ScreenUpdating = True
                    Application.ExecuteExcel4Macro "Show.ToolBar(""Ribbon"", True)"
                    Application.DisplayFormulaBar = True
                    ActiveWindow.DisplayHeadings = True
                    ActiveWindow.DisplayGridlines = True
                    Application.DisplayAlerts = True
                    Application.ScreenUpdating = True
                        'Saved = True
                         With ThisWorkbook
                        .Save
                        '.Close
            End With
            
            Application.Goto wbnewlog.Worksheets("PII Yields").Range("A1"), True
            
            
                     End Sub

 

[lcrumb]

You have one up on me bc I've just started getting into it about a month ago. I appreciate your help! I'm going to tinker around with this code and see what I can do.. Thanks again! Appreciate it a lot.

 

[Brain003]

Hello Everyone,
I want a macro to import data from a workbook with few sheets, the workbook has the same worksheets now what I need is only few values from let's say two worksheets. File name will change for every customer, can I have a openfilepath then I will locate where is the workbook is, from that workbook look in the worksheet and read the values I need, each time i click the macro i want to have values in rows like 1,2,3,4 down. example file #4432 I only need like the date it was created, project amount, paid balance. Can anyone think of a code that would be possible?

Thank you,

I have this code so far,

Sub GetOpenFile()
Dim fileStr As String
fileStr = Application.GetOpenFilename()
If fileStr = "False" Then Exit Sub
Workbooks.Open fileStr
End Sub