Copier des données dans un autre classeur

Question

J'utilise deux classeurs (évidemment basés sur la question :)), du premier (comme vous le verrez dans le code ci-dessous) est trié par les données dans la colonne "B". Les données de cette colonne sont simplement un nombre basé sur le mois (11 = novembre, décembre = 12, etc.). Pour cette question (et il fournira la réponse pour mes autres classeurs mensuels), vous devez copier toutes les lignes de données (colonnes A: AE) dans la colonne B vers un autre classeur (qui est déjà ouvert), et coller les données dans le rangée vide en bas. J'ai la pièce de tri qui fonctionne bien. Je suis en train d'ajouter dans la copie & fonction de pâte dans le code, mais ne peut pas le faire fonctionner. AIDEZ-MOI!

Voici le code que j'ai essayé (mais ne peut pas comprendre comment obtenir focus sur le classeur cible):

Sub Extract_Sort_1512_December() 
' This line renames the worksheet to "Extract" 
Application.ScreenUpdating = False 
    ActiveSheet.Name = "Extract" 

' This line autofits the columns C, D, O, and P 
    Range("C:C,D:D,O:O,P:P").Columns.AutoFit 

' This unhides any hidden rows 
    Cells.EntireRow.Hidden = False 

Dim LR As Long 

With ActiveWorkbook.Worksheets("Extract").Sort 
    With .SortFields 
     .Clear 
     .Add Key:=Range("B2:B2000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal 

    End With 
    .SetRange Range("A2:Z2000") 
    .Apply 
End With 

    For LR = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1 
     If Range("B" & LR).Value <> "12" Then 
      Rows(LR).EntireRow.Hidden = True 
     End If 
    Next LR 

Cells.WrapText = False 
Sheets("Extract").Range("A2").Select 

Dim LastRow As Integer, i As Integer, erow As Integer 
LastRow = ActiveSheet.Range(“A” & Rows.Count).End(xlUp).Row 

    For i = 2 To LastRow 
     If Cells(i, 2) = “12” Then 
     Range(Cells(i, 1), Cells(i, 31)).Select 
     Selection.Copy 

     ActiveWorkbook(“Master File - Swivel - December 2015.xlsm”).Select 
     Worksheets(“Master”).Select 
     erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 

     ActiveSheet.Cells(erow, 1).Select 
     ActiveSheet.Paste 
     End If 
    Next i 

Application.ScreenUpdating = True 
End Sub 

J'ai trouvé ce code ci-dessous, mais ne savent pas comment l'insérer correctement dans mon code ci-dessus. Ce qui me fatigue, c'est que les classeurs sont déjà ouverts. Le classeur cible est situé sur notre site SharePoint et je ne sais pas comment (ou si) vous pouvez utiliser le code VBA pour l'ouvrir sur votre bureau.

Voici l'autre code:

Sub Demo() 

    Dim wbSource As Workbook 
    Dim wbTarget As Workbook 

    ' First open both workbooks : 
    Set wbSource = Workbooks.Open(" ") ' <<< path to source workbook 
    Set wbTarget = ActiveWorkbook ' Workbooks.Open(" ") ' <<< path to destination workbook 

    'Now, transfer values from wbSource to wbTarget: 
    wbTarget.Sheets("Sheet1").Range("B2").Value = wbSource.Sheets("Sheet3").Range("H4") 
    wbTarget.Sheets("Sheet1").Range("B3").Value = wbSource.Sheets("Sheet3").Range("J10") 

    'Close source: 
    wbSource.Close 

End Sub 

Answer 1

J'ai modifié légèrement votre code, mais conservé la plupart où ils sont.

Je pense que le problème était lié à la façon dont vous essayiez d'activer le classeur dans lequel les données devaient être collées. Normalement, la commande Activate est utilisée avec les classeurs, par opposition à Select. Cependant, j'ai contourné toute l'activation du nouveau classeur, car cela nécessiterait de "réactiver" le classeur d'origine avant de copier la ligne suivante. Sinon, vous copieriez à partir du classeur actif, qui serait désormais celui à coller. S'il vous plaît voir le code - il devrait être assez simple.

Sub Extract_Sort_1512_December() 

    Application.ScreenUpdating = False 

    ' This line renames the worksheet to "Extract" 
    ActiveSheet.Name = "Extract" 

    ' This line autofits the columns C, D, O, and P 
    Range("C:C,D:D,O:O,P:P").Columns.AutoFit 

    ' This unhides any hidden rows 
    Cells.EntireRow.Hidden = False 

    Dim LR As Long 

    With ActiveWorkbook.Worksheets("Extract").Sort 
     With .SortFields 
      .Clear 
      .Add Key:=Range("B2:B2000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal 
     End With 
     .SetRange Range("A2:Z2000") 
     .Apply 
    End With 

    For LR = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1 
     If Not Range("B" & LR).Value = "12" Then 
      Rows(LR).EntireRow.Hidden = True 
     End If 
    Next LR 

    Cells.WrapText = False 
    Sheets("Extract").Range("A2").Select 

    Dim LastRow As Integer, i As Integer, erow As Integer 

    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 
    For i = 2 To LastRow 
     If Cells(i, 2) = "12" Then 

      ' As opposed to selecting the cells, I just copy them directly 
      Range(Cells(i, 1), Cells(i, 31)).Copy 

      ' As opposed to "Activating" the workbook, and selecting the sheet, I just paste the cells directly 
      With Workbooks("Master File - Swivel - December 2015.xlsm").Sheets("Master") 
       erow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
       .Cells(erow, 1).PasteSpecial xlPasteAll 
      End With 

      Application.CutCopyMode = False 

     End If 
    Next i 

    Application.ScreenUpdating = True 

End Sub