Question

我第一次来这个网站。我有一张工作表我输入数据，最后点击一个命令按钮我将该工作表的数据传输到另外两张工作表中，其中一张工作正在查找，因为它将转到单元格，然后偏移其他数据点。

另一个它复制到下一个可用的单元格但是如果在该范围内有多个它可以覆盖它而不是转到下一个单元格。所以请查看Adddata2并告诉我我做错了什么，如果我只有一个数据条目可以工作，但是如果我有多个它会删除第一个添加的并放入新的，如果有空的话细胞它做同样的事情。 SortCmt是我要找的！

谢谢

Private Sub cmdAjouter5S_Click()
On Error GoTo ERAJOUT
Dim AddDATA As Range


Dim AddDATA2 As Range
Dim MSG, STYLE, TITLE, RESPONSE
Dim Éliminer, Ranger, Nettoyer, Standard, Respect As Variant
Dim SortCmt1, SortCmt2, SortCmt3, SortCmt4, SortCmt5 As String
Dim SetCmt1, SetCmt2, SetCmt3, SetCmt4, SetCmt5 As String
Dim ShineCmt1, ShineCmt2, ShineCmt3, ShineCmt4, ShineCmt5 As String
Dim StandCmt1, StandCmt2, StandCmt3, StandCmt4, StandCmt5 As String
Dim SusCmt1, SusCmt2, SusCmt3, SusCmt4, SusCmt5 As String
Dim AddDate As Date
Dim OPCL As String
Dim RNG As Range

'Définition des variables afin de prendre et d'envoyer les donnée au bon endroit
Set AddDATA = Sheet2.Cells(Rows.Count, 22).End(xlUp).Offset(1, 0)
Set AddDATA2 = Sheet63.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Set RNG = Sheet63.Range("B2:B500")
SortCmt1 = Range("B27").Value
SortCmt2 = Range("B28").Value
SortCmt3 = Range("B29").Value
SortCmt4 = Range("B30").Value
SortCmt5 = Range("B31").Value

'Définition des variables de données
Éliminer = Range("E9").Value
Ranger = Range("G9").Value
Nettoyer = Range("I9").Value
Standard = Range("K9").Value
Respect = Range("M9").Value
AddDate = Sheet1.DTPicker1.Value
Verificateur = Range("D4").Value
OPCL = "Open"

MSG = "Êtes-vous sûr de vouloir ajouter les données?" & vbCrLf & vbCrLf & _
"Vous ne pourrez les modifiées par la suite, donc assurez-vous que celles-ci sont exactes!"
STYLE = vbYesNo + vbCritical + vbDefaultButton2
TITLE = "IMPORTANT MESSAGE"
RESPONSE = MsgBox(MSG, STYLE, TITLE)

If Range("P9").Value = 0 Or Range("D4").Value = 0 Or Range("P9").Value = "Error" Then GoTo EAJOUT
If RESPONSE = vbYes Then
  AddDATA.Value = AddDate
  AddDATA.Offset(0, 2).Value = Éliminer
  AddDATA.Offset(0, 3).Value = Ranger
  AddDATA.Offset(0, 4).Value = Nettoyer
  AddDATA.Offset(0, 5).Value = Standard
  AddDATA.Offset(0, 6).Value = Respect
  AddDATA.Offset(0, 11).Value = Verificateur
  AddDATA2.Value = SortCmt1
  AddDATA2.Value = SortCmt2
  AddDATA2.Value = SortCmt3
  AddDATA2.Value = SortCmt4
  AddDATA2.Value = SortCmt5

  MsgBox "Vos données ont été ajoutez!" & vbCrLf & "Merci", vbInformation, "Équipe 5S!"

Else
  MsgBox "Vérifiez et recommencez au besoin", vbInformation, "VÉRIFICATION"
  GoTo AJOUT
End If

Range("B27:B31").Value = ""
Range("B42:B46").Value = ""
Range("B57:B61").Value = ""
Range("B72:B76").Value = ""
Range("B87:B91").Value = ""
Range("S20:S24").Value = ""
Range("S35:S39").Value = ""
Range("S50:S54").Value = ""
Range("S65:S69").Value = ""
Range("S80:S84").Value = ""
Range("D4").Value = ""

For Each cell In RNG
  If cell.Value <> "" And IsEmpty(cell.Offset(0, 3).Value) = True Then
    cell.Offset(0, 3).Value = OPCL
  End If
Next

GoTo AJOUT
EAJOUT:
MsgBox "Vous n'avez pas entrées de donnée! Retournez entrer vos données."

AJOUT:
Exit Sub

ERAJOUT:
MsgBox Err.Description
MsgBox "Une erreur c'est produite voir avec Martin SVP"
Resume EAJOUT

End Sub

Answer 1

因为：

AddDATA2.Value = SortCmt1
AddDATA2.Value = SortCmt2
AddDATA2.Value = SortCmt3
AddDATA2.Value = SortCmt4
AddDATA2.Value = SortCmt5

你的覆盖5倍于单元格AddDATA2的值

如果你想从AddDATA2单元格开始写下Sheet63.Range（＆＃34; B27：B31＆＃34;）值，那么你就写了：

AddDATA2.Resize(5).Value = Sheet63.Range("B27:B31").Value

或者，如果您希望从AddDATA2向右行复制这些值：

AddDATA2.Resize(,5).Value = Application.Transpose(Sheet63.Range("B27:B31").Value)

如何一次只复制一个单元格范围并始终在最后一行？

1 个答案: