Copying data’s from another workbook.

[asyamonique]

Hello,
is there any way to open the workbook from a folder and copy below info ranges and to paste into your original file And close the target file without interruption by running a code?
Many thanks.

target folder name: master
workbook name: document2
worksheet: Sheet1
ranges: A:BD

original workbook name: MSTR
worksheet:Sheet1
ranges: A:BD

 

[davesexcel]

Use your macro recorder and perform those actions.

copy and paste your code in your next post and somebody can help clean it up for you

 

[asyamonique]

It works very slow
how can I speed up the code?
Thanks

Application.ScreenUpdating = False

Dim wbAr As Workbook, wbBr As Workbook
Dim ar As Range
Set wbBr = ThisWorkbook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set wbAr = Workbooks.Open(Filename:="C:\Users\xyz\Desktop\Master\Document2.xls")
wbAr.Worksheets(1).Range("A:BG").Select
Selection.Copy
Windows("Master.xlsm").Activate
Sheets("sheet1").Select
wbBr.Sheets("sheet1").Range("A:BG").Select
ActiveSheet.Paste
wbAr.Close    
    
Application.ScreenUpdating = True

 

[davesexcel]

Check it out.

Sub CopyFromOtherWB()
    Dim wbAr As Workbook, wbBr As Workbook
    Dim sh As Worksheet, ws As Worksheet
    Dim ar As Range, PstRng As Range
    Dim Rws As Long
    
    Set wbBr = ThisWorkbook
    Set sh = wbBr.Sheets(1)
    Set PstRng = sh.Range("A1")
    
    Application.ScreenUpdating = False
    'change the workbook open location and name
    Set wbAr = Workbooks.Open(Filename:="C:\Users\davem\Downloads\Sample1\Doc2.xlsx")
    Set ws = wbAr.Worksheets(1)
    
    With ws
        Rws = .Cells.Find(What:="*", After:=.Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Set ar = .Range("A1:BG" & Rws)
    End With
    
    ar.Copy PstRng
    
    wbAr.Close False
    
End Sub

 

[asyamonique]

Many thanks.
Its better?

 

[VBasic2008]

Open, Copy, Close

Option Explicit

Sub openCopyClose()
    
    ' Source
    Const srcFilePath As String = "C:\Users\xyz\Desktop\Master\Document2.xls"
    Const srcName As String = "Sheet1"
    Const srcColumns As String = "A:BG"
    ' Target
    Const tgtName As String = "Sheet1"
    Const tgtFirstCell As String = "A1"
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containing this code.
    
    With Workbooks.Open(Filename:=srcFilePath)
        Dim rng As Range
        Set rng = defineNonEmptyRange(.Worksheets(srcName).Range(srcColumns))
        If Not rng Is Nothing Then
            ' If values are enough, definitely use this most efficient solution.
            With wb.Worksheets(tgtName).Range(tgtFirstCell)
                .Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
            End With
            ' If you need values, formulas, formats... then use this:
            'rng.Copy wb.Worksheets(tgtName).Range(tgtFirstCell)
        End If
        .Close SaveChanges:=False
    End With
    
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Defines a Non-Empty Range.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function defineNonEmptyRange(SourceRange As Range, _
                             Optional ByVal FirstRow As Long = 1, _
                             Optional ByVal FirstColumn As Long = 1) _
         As Range
    
    ' Validate Source Range.
    If SourceRange Is Nothing Then
        GoTo ProcExit ' Source Range is Nothing.
    End If
    ' Validate First Row.
    If FirstRow < 1 Then
        GoTo ProcExit ' First Row is less than one.
    ElseIf SourceRange.Rows.Count < FirstRow Then
        GoTo ProcExit ' Source Range contains fewer rows than First Row.
    End If
    ' Validate First Column.
    If FirstColumn < 1 Then
        GoTo ProcExit ' First Columnn is less than one.
    ElseIf SourceRange.Columns.Count < FirstColumn Then
        GoTo ProcExit ' Source Range contains fewer columns than First Column.
    End If
    
    ' Define Processing Range ('rng').
    Dim rng As Range
    Set rng = SourceRange.Resize(SourceRange.Rows.Count - FirstRow + 1, _
                                 SourceRange.Columns.Count - FirstColumn + 1) _
                         .Offset(FirstRow - 1, FirstColumn - 1)
    
    ' Define Last Cell ('cel') in Last Non-Empty Row.
    Dim cel As Range
    Set cel = rng.Cells.Find(What:="*", _
                             LookIn:=xlFormulas, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlPrevious)
    ' Validate Last Cell.
    If cel Is Nothing Then
        GoTo ProcExit ' Processing Range is empty, Last Cell is Nothing.
    End If
    ' Define Last Non-Empty Row.
    Dim LastRow As Long
    LastRow = cel.Row
    
    ' Define Last Cell ('cel') in Last Non-Empty Column.
    Set cel = rng.Cells.Find(What:="*", _
                             SearchDirection:=xlPrevious)
    ' Note: The previous validation is ensuring that
    '       the Last Non-Empty Column is 'cel.Column' i.e. that it is valid.
        
    ' Define Non-Empty Range.
    Set defineNonEmptyRange = rng.Resize(LastRow - rng.Row + 1, _
                                         cel.Column - rng.Column + 1)

ProcExit:
End Function