web-dev-qa-db-fra.com

Gamme de pâte VBA

J'ai pour objectif simple de copier la plage et de la coller dans un autre spreadsheet. Le code ci-dessous donne des copies, mais ne colle pas.

Sub Normalize()

    Dim Ticker As Range
    Sheets("Sheet1").Activate
    Set Ticker = Range(Cells(2, 1), Cells(65, 1))
    Ticker.Copy

    Sheets("Sheet2").Select
    Cells(1, 1).Activate
    Ticker.PasteSpecial xlPasteAll

End Sub

Aucune suggestion?

excelvbarangepaste
6
user1700890

Pour corriger littéralement votre exemple, vous utiliseriez ceci:

Sub Normalize()


    Dim Ticker As Range
    Sheets("Sheet1").Activate
    Set Ticker = Range(Cells(2, 1), Cells(65, 1))
    Ticker.Copy

    Sheets("Sheet2").Select
    Cells(1, 1).PasteSpecial xlPasteAll



End Sub

Pour y apporter de légères améliorations, il faudrait se débarrasser du Select and Activates:

Sub Normalize()
    With Sheets("Sheet1")
        .Range(.Cells(2, 1), .Cells(65, 1)).Copy Sheets("Sheet2").Cells(1, 1)
    End With
End Sub

mais l'utilisation du presse-papiers prend du temps et des ressources, donc la meilleure façon serait d'éviter un copier-coller et de simplement définir les valeurs égales à ce que vous voulez.

Sub Normalize()
Dim CopyFrom As Range

Set CopyFrom = Sheets("Sheet1").Range("A2", [A65])
Sheets("Sheet2").Range("A1").Resize(CopyFrom.Rows.Count).Value = CopyFrom.Value

End Sub

Pour définir le CopyFrom vous pouvez utiliser tout ce que vous voulez pour définir la plage, vous pouvez utiliser Range("A2:A65"), Range("A2",[A65]), Range("A2", "A65") tout serait valide entrées. aussi si l'A2: A65 ne changera jamais le code pourrait être encore simplifié pour:

Sub Normalize()

Sheets("Sheet2").Range("A1:A65").Value = Sheets("Sheet1").Range("A2:A66").Value

End Sub

J'ai ajouté la copie depuis la plage et la propriété Resize pour la rendre légèrement plus dynamique au cas où vous auriez d'autres plages que vous voudriez utiliser à l'avenir.

23
user2140261

C'est ce que j'ai trouvé en essayant de copier-coller des plages Excel avec ses tailles et ses groupes de cellules. C'est peut-être un peu trop spécifique pour mon problème mais ...:

'**' Copie une table d'un endroit à un autre 'TargetRange: où placer le nouveau LayoutTable' typee: S'il s'agit d'une table de mise en page d'installation (1) ou d'une table de mise en page de package (2) '**

Sub CopyLayout(TargetRange As Range, typee As Integer)
    Application.ScreenUpdating = False
        Dim ncolumn As Integer
        Dim nrow As Integer

        SheetLayout.Activate
    If (typee = 1) Then 'is installation
        Range("installationlayout").Copy Destination:=TargetRange '@SHEET2 TEM DE PASSAR A SER A SHEET DO PROJECT PLAN!@@@@@
    ElseIf (typee = 2) Then 'is package
        Range("PackageLayout").Copy Destination:=TargetRange '@SHEET2 TEM DE PASSAR A SER A SHEET DO PROJECT PLAN!@@@@@
    End If

    Sheet2.Select 'SHEET2 TEM DE PASSAR A SER A SHEET DO PROJECT PLAN!@@@@@

    If typee = 1 Then
       nrow = SheetLayout.Range("installationlayout").Rows.Count
       ncolumn = SheetLayout.Range("installationlayout").Columns.Count

       Call RowHeightCorrector(SheetLayout.Range("installationlayout"), TargetRange.CurrentRegion, typee, nrow, ncolumn)
    ElseIf typee = 2 Then
       nrow = SheetLayout.Range("PackageLayout").Rows.Count
       ncolumn = SheetLayout.Range("PackageLayout").Columns.Count
       Call RowHeightCorrector(SheetLayout.Range("PackageLayout"), TargetRange.CurrentRegion, typee, nrow, ncolumn)
    End If
    Range("A1").Select 'Deselect the created table

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

'**' Reçoit la plage de table collée et réorganise ses propriétés 'en fonction du type CopiedTable d'origine': S'il s'agit d'une table de disposition d'installation (1) ou d'une table de disposition de package (2) '**

Function RowHeightCorrector(CopiedTable As Range, PastedTable As Range, typee As Integer, RowCount As Integer, ColumnCount As Integer)
    Dim R As Long, C As Long

    For R = 1 To RowCount
        PastedTable.Rows(R).RowHeight = CopiedTable.CurrentRegion.Rows(R).RowHeight
        If R >= 2 And R < RowCount Then
            PastedTable.Rows(R).Group 'Main group of the table
        End If
        If R = 2 Then
            PastedTable.Rows(R).Group 'both type of tables have a grouped section at relative position "2" of Rows
        ElseIf (R = 4 And typee = 1) Then
            PastedTable.Rows(R).Group 'If it is an installation materials table, it has two grouped sections...
        End If
    Next R

    For C = 1 To ColumnCount
        PastedTable.Columns(C).ColumnWidth = CopiedTable.CurrentRegion.Columns(C).ColumnWidth
    Next C
End Function



Sub test ()
    Call CopyLayout(Sheet2.Range("A18"), 2)
end sub
0
Twimnox75

Je voudrais essayer

Sheets("Sheet1").Activate
Set Ticker = Range(Cells(2, 1), Cells(65, 1))
Ticker.Copy

Worksheets("Sheet2").Range("A1").Offset(0,0).Cells.Select
Worksheets("Sheet2").paste
0
John Moore