Cómo copiar datos de otro libro de trabajo (excel)?

Question

Ya tengo una macro que crea hojas y algunas otras cosas. Después de que se haya creado una hoja, quiero llamar a otra macro que copie los datos de un segundo Excel (está abierto) al primero y al archivo de Excel activo.

Primero quiero copiar a los encabezados, pero no puedo hacerlo funcionar, sigo recibiendo errores.

Sub CopyData(sheetName as String) 
    Dim File as String, SheetData as String 

    File = "my file.xls" 
    SheetData = "name of sheet where data is" 

    # Copy headers to sheetName in main file 
    Workbooks(File).Worksheets(SheetData).Range("A1").Select # fails here: Method Select for class Range failed 
    Workbooks(File).Worksheets(SheetData).Range(Selection, Selection.End(xlToRight)).Select 
    Workbooks(File).Worksheets(SheetData).Selection.Copy ActiveWorkbook.Sheets(sheetName).Cells(1, 1) 
End Sub 

¿Qué pasa?

Realmente quiero evitar tener que activar "my file.xls".

Editar: Tuve que dejarlo y copiar el SheetData al archivo de destino como una hoja nueva, antes de que pudiera funcionar. Find and select multiple rows

Answer 1

¿Te alegrará activar "mi archivo.xls" si no afecta la pantalla? Desactivar la actualización de la pantalla es la forma de lograrlo, también tiene mejoras en el rendimiento (significativo si está haciendo un bucle mientras cambia de hoja de trabajo/libro de trabajo).

El comando para hacer esto es:

Application.ScreenUpdating = False 

No se olvide para volver a True Cuando se termina sus macros.

Answer 2

No creo que deba seleccionar nada en absoluto. Abrí dos libros en blanco Book1 y Book2, puse el valor "A" en el rango ("A1") de Sheet1 en Book2, y envié el siguiente código en la ventana inmediata -

Workbooks (2) .Worksheets (1) .Range ("A1"). Copiar Workbooks (1) .Worksheets (1) .Range ("A1")

El rango ("A1") en la Hoja 1 de Book1 ahora contiene "A".

Además, dado que en su código está tratando de copiar de ActiveWorkbook a "miarchivo.xls", el pedido parece estar invertido ya que el método de Copiar se debe aplicar a un rango en ActiveWorkbook, y el destino (argumento para la función Copiar) debe ser el rango apropiado en "miarchivo.xls".

Answer 3

Dos años más tarde (esto se encontró en Google, por lo que para cualquier otra persona) ... Como se mencionó anteriormente, no es necesario que seleccione nada. Estas tres líneas:

Workbooks(File).Worksheets(SheetData).Range("A1").Select
Workbooks(File).Worksheets(SheetData).Range(Selection, Selection.End(xlToRight)).Select
Workbooks(File).Worksheets(SheetData).Selection.Copy ActiveWorkbook.Sheets(sheetName).Cells(1, 1)

puede ser reemplazado por

Workbooks(File).Worksheets(SheetData).Range(Workbooks(File).Worksheets(SheetData). _
Range("A1"), Workbooks(File).Worksheets(SheetData).Range("A1").End(xlToRight)).Copy _
Destination:=ActiveWorkbook.Sheets(sheetName).Cells(1, 1)

Esto debe moverse por el error de selección.

Answer 4

La mejor práctica es abrir el archivo fuente (con un estado visible falso si no desea molestarse) lea sus datos y luego lo cerramos.

Un trabajo y un código limpio es avalaible en el siguiente enlace:

http://vba-useful.blogspot.fr/2013/12/how-do-i-retrieve-data-from-another.html

Answer 5

yo estaba en necesidad de copiar los datos de un libro a otro usando VBA. El requisito fue como se menciona a continuación 1.Al presionar un botón de Active X, abra el diálogo para seleccionar el archivo desde el cual se deben copiar los datos. 2. Al hacer clic en Aceptar, el valor debe ser copiado de una celda/rango al libro de trabajo actualmente en funcionamiento.

No quería utilizar la función de apertura, ya que abre el libro que será molesto

A continuación se muestra el código que he escrito en la VBA. Cualquier mejora o nueva alternativa es bienvenida.

Código: Aquí estoy copiando la A1: C4 contenido de un libro a la A1: C4 del libro actual

Private Sub CommandButton1_Click() 
     Dim BackUp As String 
     Dim cellCollection As New Collection 
     Dim strSourceSheetName As String 
     Dim strDestinationSheetName As String 
     strSourceSheetName = "Sheet1" 'Mention the Source Sheet Name of Source Workbook 
     strDestinationSheetName = "Sheet2" 'Mention the Destination Sheet Name of Destination Workbook 


     Set cellCollection = GetCellsFromRange("A1:C4") 'Mention the Range you want to copy data from Source Workbook 

     With Application.FileDialog(msoFileDialogOpen) 
      .AllowMultiSelect = False 
      .Show 
      '.Filters.Add "Macro Enabled Xl", "*.xlsm;", 1 

      For intWorkBookCount = 1 To .SelectedItems.Count 
       Dim strWorkBookName As String 
       strWorkBookName = .SelectedItems(intWorkBookCount) 
       For cellCount = 1 To cellCollection.Count 
        On Error GoTo ErrorHandler 
        BackUp = Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) 
        Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = GetData(strWorkBookName, strSourceSheetName, cellCollection.Item(cellCount)) 
        Dim strTempValue As String 
        strTempValue = Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)).Value 
        If (strTempValue = "0") Then 
         strTempValue = BackUp 
        End If 
Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = strTempValue 
ErrorHandler: 
        If (Err.Number <> 0) Then 
          Sheets(strDestinationSheetName).Range(cellCollection.Item(cellCount)) = BackUp 
         Exit For 
        End If 
       Next cellCount 
      Next intWorkBookCount 
     End With 

    End Sub 

    Function GetCellsFromRange(RangeInScope As String) As Collection 
     Dim startCell As String 
     Dim endCell As String 
     Dim intStartColumn As Integer 
     Dim intEndColumn As Integer 
     Dim intStartRow As Integer 
     Dim intEndRow As Integer 
     Dim coll As New Collection 

     startCell = Left(RangeInScope, InStr(RangeInScope, ":") - 1) 
     endCell = Right(RangeInScope, Len(RangeInScope) - InStr(RangeInScope, ":")) 
     intStartColumn = Range(startCell).Column 
     intEndColumn = Range(endCell).Column 
     intStartRow = Range(startCell).Row 
     intEndRow = Range(endCell).Row 

     For lngColumnCount = intStartColumn To intEndColumn 
      For lngRowCount = intStartRow To intEndRow 
       coll.Add (Cells(lngRowCount, lngColumnCount).Address(RowAbsolute:=False, ColumnAbsolute:=False)) 
      Next lngRowCount 
     Next lngColumnCount 

     Set GetCellsFromRange = coll 
    End Function 

    Function GetData(FileFullPath As String, SheetName As String, CellInScope As String) As String 
     Dim Path As String 
     Dim FileName As String 
     Dim strFinalValue As String 
     Dim doesSheetExist As Boolean 

     Path = FileFullPath 
     Path = StrReverse(Path) 
     FileName = StrReverse(Left(Path, InStr(Path, "\") - 1)) 
     Path = StrReverse(Right(Path, Len(Path) - InStr(Path, "\") + 1)) 

     strFinalValue = "='" & Path & "[" & FileName & "]" & SheetName & "'!" & CellInScope 
     GetData = strFinalValue 
    End Function