3 votes

Copier SEULEMENT le texte d'une plage et coller SEULEMENT les trois premiers textes sur une autre feuille

J'ai jusqu'à 6 cellules avec des données potentielles provenant de 6 endroits différents. J'essaie de faire en sorte que seules les trois premières cellules contenant des données soient transférées vers une autre feuille.

Private Sub Transfer_Data()

Sheets("sheet1").Range("A1:A6").SpecialCells(xlCellTypeConstants, 23).copy

Sheets("sheet2").Range("A1:A3").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

End Sub

C'est ce que j'ai, je sais qu'il me manque beaucoup de choses.

2voto

dwirony Points 4902

C'est comme ça que je ferais :

Sub Transfer_Data()

Dim i As Long, j As Long

j = 1

For i = 1 To 6
    If Sheets("Sheet1").Cells(i, 1).Value <> "" Then
        Sheets("Sheet2").Cells(j, 1).Value = Sheets("Sheet1").Cells(i, 1).Value
        j = j + 1
    End If

    If j > 3 Then Exit For
Next i

End Sub

ÉDITION :

Sub Transfer_Data()

    Dim i As Long, j As Long

    j = 3

    For i = 1 To 6
        If Sheets("Sheet1").Cells(i, 1).Value <> "" Then
            Sheets("Sheet2").Cells(j, 1).Value = Sheets("Sheet1").Cells(i, 1).Value
            j = j - 1
        End If

        If j = 0 Then Exit For
    Next i

End Sub

1voto

chillin Points 2671

Non testé, il existe peut-être un autre moyen, plus élégant, de procéder :

Private Sub TransferData()

Dim cellCount as long

Dim cell as range
Dim rangeToCopy as range

For each cell in  Sheets("sheet1").Range("A1:A6").SpecialCells(xlCellTypeConstants) ' 23 is unnecessary, as you get all XlSpecialCellsValue constants by default
' See https://docs.microsoft.com/en-us/office/vba/api/excel.range.specialcells
cellCount = cellCount + cell.cells.count

If not (rangeToCopy is nothing) then
Set rangeToCopy = application.union(rangeToCopy, cell)
Else
Set rangeToCopy = cell
End if

If cellCount = 3 then exit for

Next cell

If not (rangeToCopy is nothing) then
rangeToCopy.copy

Sheets("sheet2").Range("A1").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

End if

End Sub

1voto

Ryan Wildry Points 2386

Je sais qu'on a déjà répondu à cette question, mais pourquoi pas une phrase folle ?

Sub TransferData()
    ThisWorkbook.Sheets("Sheet2").Range("A1:A3").Value2 = WorksheetFunction.Transpose(Split(Replace$(Join(WorksheetFunction.Transpose(ThisWorkbook.Sheets("Sheet1").Range("A1:A6").Value2), ","), ",,", ","), ","))
End Sub

Prograide.com

Prograide est une communauté de développeurs qui cherche à élargir la connaissance de la programmation au-delà de l'anglais.
Pour cela nous avons les plus grands doutes résolus en français et vous pouvez aussi poser vos propres questions ou résoudre celles des autres.

Powered by:

X