Probleme de code
Bonjour,
J'ai un programme qui me permet de copier une plage de colonne sur deux mais quand je veux sélectionner et coller ( en transposer) ça m'indique que j'ai une erreur...
Vous pouvez me donner un coup de main ?
Sub copier()
'onglet
Sheets("Carte contrôle grammage BLOWN").Copy After:=Workbooks("6A9TZ050.xlsm").Sheets(Workbooks("6A9TZ050.xlsm").Sheets.Count)
Range("B13").Select
' copier de carte de controle a la feuil1
Dim plage As Range
Dim i As Integer
Dim selection As Range
' Spécifie le nombre de plages à sélectionner
Dim nombrePlages As Integer
nombrePlages = 88 ' Modifier selon le nombre de plages souhaité
' Boucle à travers chaque plage
For i = 0 To nombrePlages - 1
' Spécifie la première cellule de la plage
Set plage = Range(Cells(13, 2 + i * 2), Cells(22, 2 + i * 2))
' Ajoute la plage à la sélection
If selection Is Nothing Then
Set selection = plage
Else
Set selection = Union(selection, plage)
End If
Next i
' Sélectionne les plages obtenues
If Not selection Is Nothing Then
selection.Select
End If
selection.Copy
Sheets("Feuil1").Select
Range("q11").Select
selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
selection.SpecialCells(xlCellTypeBlanks).Select
selection.Delete Shift:=xlUp
Sheets("Carte contrôle grammage BLOWN").Range("h1").Copy
Sheets("Feuil1").Range("P11:p101").PasteSpecial Paste:=xlPasteValues
'copier final
Range("p11:z20").Select
selection.Copy
Cells(65535, 1).End(xlUp)(2).Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
On Error Resume Next
[b:b].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.DisplayAlerts = False
Sheets("Carte contrôle grammage BLOWN").Delete
Application.DisplayAlerts = True
End Sub
Bonjour Danang,
A tester :
Sub copier()
'onglet
Sheets("Carte contrôle grammage BLOWN").Copy After:=Workbooks("6A9TZ050.xlsm").Sheets(Workbooks("6A9TZ050.xlsm").Sheets.Count)
Range("B13").Select
' copier de carte de controle a la feuil1
Dim plage As Range
Dim i As Integer
Dim selection As Range
' Spécifie le nombre de plages à sélectionner
Dim nombrePlages As Integer
nombrePlages = 88 ' Modifier selon le nombre de plages souhaité
' Boucle à travers chaque plage
For i = 0 To nombrePlages - 1
' Spécifie la première cellule de la plage
Set plage = Range(Cells(13, 2 + i * 2), Cells(22, 2 + i * 2))
' Ajoute la plage à la sélection
If selection Is Nothing Then
Set selection = plage
Else
Set selection = Union(selection, plage)
End If
Next i
' Sélectionne les plages obtenues
If Not selection Is Nothing Then
selection.Select
End If
selection.Copy
Sheets("Feuil1").Select
' Ajuste la plage de destination pour la transposition
Range("Q11").Resize(selection.Columns.Count, selection.Rows.Count).Select
selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
On Error Resume Next
selection.SpecialCells(xlCellTypeBlanks).Select
selection.Delete Shift:=xlUp
Sheets("Carte contrôle grammage BLOWN").Range("h1").Copy
Sheets("Feuil1").Range("P11:p101").PasteSpecial Paste:=xlPasteValues
'copier final
Range("p11:z20").Select
selection.Copy
Cells(65535, 1).End(xlUp)(2).Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
On Error Resume Next
[b:b].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.DisplayAlerts = False
Sheets("Carte contrôle grammage BLOWN").Delete
Application.DisplayAlerts = True
End SubJ'espère que cela vous aidera.
Merci de votre réponse ...
Malheureusement j'ai toujours le même problème...
selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=TrueSur cette partie du programme il me met comme quoi il y a un problème...
Il semble que le problème puisse être dû à l'utilisation incorrecte de l'objet selection. Après avoir copié selection, vous sélectionnez une nouvelle plage sur une autre feuille, mais ne mettez pas à jour la référence selection pour pointer vers cette nouvelle plage. Par conséquent, lorsque vous appelez selection.PasteSpecial, il essaie toujours de fonctionner sur l'ancienne plage, qui a été supprimée du presse-papiers lorsque vous avez changé de feuille.
Au lieu d'utiliser la méthode Select pour changer de plage, nous allons utiliser directement la méthode PasteSpecial sur la nouvelle plage. De cette façon, nous n'aurons pas besoin de mettre à jour la référence selection.
Un exemple de code que vous pourrez tester :
Sub copier()
'onglet
Sheets("Carte contrôle grammage BLOWN").Copy After:=Workbooks("6A9TZ050.xlsm").Sheets(Workbooks("6A9TZ050.xlsm").Sheets.Count)
Range("B13").Select
' copier de carte de controle a la feuil1
Dim plage As Range
Dim i As Integer
Dim selection As Range
' Spécifie le nombre de plages à sélectionner
Dim nombrePlages As Integer
nombrePlages = 88 ' Modifier selon le nombre de plages souhaité
' Boucle à travers chaque plage
For i = 0 To nombrePlages - 1
' Spécifie la première cellule de la plage
Set plage = Range(Cells(13, 2 + i * 2), Cells(22, 2 + i * 2))
' Ajoute la plage à la sélection
If selection Is Nothing Then
Set selection = plage
Else
Set selection = Union(selection, plage)
End If
Next i
' Sélectionne les plages obtenues
If Not selection Is Nothing Then
selection.Select
End If
selection.Copy
' Modification ici - utilise PasteSpecial directement sur la nouvelle plage
Sheets("Feuil1").Range("Q11").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
On Error Resume Next
selection.SpecialCells(xlCellTypeBlanks).Select
selection.Delete Shift:=xlUp
Sheets("Carte contrôle grammage BLOWN").Range("h1").Copy
Sheets("Feuil1").Range("P11:p101").PasteSpecial Paste:=xlPasteValues
'copier final
Range("p11:z20").Select
selection.Copy
Cells(65535, 1).End(xlUp)(2).Select
selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
On Error Resume Next
[b:b].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.DisplayAlerts = False
Sheets("Carte contrôle grammage BLOWN").Delete
Application.DisplayAlerts = True
End Submerxciiiiiiiiiiiiiiiiiiiiiiiii