이전 행이 비어 있더라도 삽입하십시오.

Question

이 시트는 시트에 있고 매크로가있는 명령 단추가 있습니다. 클릭하면 Sheet1 셀의 모든 데이터가 sheet2의 단일 행에 삽입됩니다. 다음 빈 행 명령을 넣었지만 이전 행이 비어있는 경우에도 모든 데이터가 동일한 행에 남아 있도록합니다.

난 다음 코드를 사용했습니다 :

Sub Botao() 
    Dim ws1, ws2 As Worksheet 
    Dim código, tipo, textobrevematerial, codigopa, textobrevepa, ncm, versão, motivo1, motivo2, motivo3, datarecebimento, _ 
     dataimpressao, datamkt, datarevisor, datasedev, dataar, datart, dataredmkt, dataredsedev As Range 

     Set ws1 = Worksheets("Plan1") 
     Set ws2 = Worksheets("Plan2") 
     Set código = ws2.Cells(Rows.Count, "a").End(xlUp) 
     Set datarecebimento = ws2.Cells(Rows.Count, "b").End(xlUp) 
     Set tipo = ws2.Cells(Rows.Count, "c").End(xlUp) 
     Set textobrevematerial = ws2.Cells(Rows.Count, "d").End(xlUp) 
     Set codigopa = ws2.Cells(Rows.Count, "e").End(xlUp) 
     Set textobrevepa = ws2.Cells(Rows.Count, "f").End(xlUp) 
     Set ncm = ws2.Cells(Rows.Count, "g").End(xlUp) 
     Set versão = ws2.Cells(Rows.Count, "h").End(xlUp) 
     Set dataimpressão = ws2.Cells(Rows.Count, "i").End(xlUp) 
     Set datamkt = ws2.Cells(Rows.Count, "j").End(xlUp) 
     Set datarevisor = ws2.Cells(Rows.Count, "k").End(xlUp) 
     Set datasedev = ws2.Cells(Rows.Count, "l").End(xlUp) 
     Set dataar = ws2.Cells(Rows.Count, "m").End(xlUp) 
     Set datart = ws2.Cells(Rows.Count, "n").End(xlUp) 
     Set motivo1 = ws2.Cells(Rows.Count, "o").End(xlUp) 
     Set motivo2 = ws2.Cells(Rows.Count, "p").End(xlUp) 
     Set motivo3 = ws2.Cells(Rows.Count, "q").End(xlUp) 
     Set dataremkt = ws2.Cells(Rows.Count, "r").End(xlUp) 
     Set dataresedev = ws2.Cells(Rows.Count, "s").End(xlUp) 

      código.Offset(1, 0) = ws1.Range("d4").Value 
      datarecebimento.Offset(1, 0) = ws1.Range("H4") 
      tipo.Offset(1, 0) = ws1.Range("b8") 
      textobrevematerial.Offset(1, 0) = ws1.Range("D8") 
      codigopa.Offset(1, 0) = ws1.Range("B12") 
      textobrevepa.Offset(1, 0) = ws1.Range("D12") 
      ncm.Offset(1, 0) = ws1.Range("B16") 
      versão.Offset(1, 0) = ws1.Range("D16") 
      dataimpressão.Offset(1, 0) = ws1.Range("F18") 
      datamkt.Offset(1, 0) = ws1.Range("F20") 
      datarevisor.Offset(1, 0) = ws1.Range("F22") 
      datasedev.Offset(1, 0) = ws1.Range("M18") 
      dataar.Offset(1, 0) = ws1.Range("M20") 
      datart.Offset(1, 0) = ws1.Range("m22") 
      motivo1.Offset(1, 0) = ws1.Range("B26") 
      motivo2.Offset(1, 0) = ws1.Range("B30") 
      motivo3.Offset(1, 0) = ws1.Range("B32") 
      dataremkt.Offset(1, 0) = ws1.Range("F38") 
      dataresedev.Offset(1, 0) = ws1.Range("M38") 

    End Sub 

그래서 이전 행에 빈 셀이 포함 된 경우에도 같은 행에 모두를 삽입하는 데 사용할해야하는지 코드?

Answer 1

편집 :이 정확한 코드는 Excel에서 나를 위해 작동 :

Sub Botao() 

Dim ws1, ws2 As Worksheet 
Dim rowNum As Long 

Set ws1 = Worksheets("Plan1") 
Set ws2 = Worksheets("Plan2") 
rowNum = ws2.Cells(Rows.Count, "a").End(xlUp).Row 'Get last used row in column A 
rowNum = rowNum + 1 'Increment to next open row 

Dim código, tipo, textobrevematerial, codigopa, textobrevepa, ncm, versão, motivo1, motivo2, motivo3, datarecebimento, _ 
dataimpressao, datamkt, datarevisor, datasedev, dataar, datart, dataredmkt, dataredsedev As Range 

'Use next open row of column A (rowNum) for all columns 
Set código = ws2.Cells(rowNum, "a") 
Set datarecebimento = ws2.Cells(rowNum, "b") 
Set tipo = ws2.Cells(rowNum, "c") 
Set textobrevematerial = ws2.Cells(rowNum, "d") 
Set codigopa = ws2.Cells(rowNum, "e") 
Set textobrevepa = ws2.Cells(rowNum, "f") 
Set ncm = ws2.Cells(rowNum, "g") 
Set versão = ws2.Cells(rowNum, "h") 
Set dataimpressão = ws2.Cells(rowNum, "i") 
Set datamkt = ws2.Cells(rowNum, "j") 
Set datarevisor = ws2.Cells(rowNum, "k") 
Set datasedev = ws2.Cells(rowNum, "l") 
Set dataar = ws2.Cells(rowNum, "m") 
Set datart = ws2.Cells(rowNum, "n") 
Set motivo1 = ws2.Cells(rowNum, "o") 
Set motivo2 = ws2.Cells(rowNum, "p") 
Set motivo3 = ws2.Cells(rowNum, "q") 
Set dataremkt = ws2.Cells(rowNum, "r") 
Set dataresedev = ws2.Cells(rowNum, "s") 

'----------Checking for duplicate in column A--------- 
Dim bool As Boolean 
bool = False     'Initialize False, until duplicate is found 

For i = 1 To (rowNum - 1)  'Go through each row of column A except the new row 
    If ws1.Range("d4") = ws2.Cells(i, "a") Then 'If it matches any old row set boolean True 
     bool = True 
    End If 
Next i 

If bool = True Then   'If duplicate was found, display MsgBox 
    Dim msg As String 
    Dim title As String 
    Dim ret As Integer 
    msg = "There is a duplicate in column A" 
    title = "Duplicate!" 

    ret = MsgBox(msg, vbOKOnly, title) 'MsgBox(Promt, Button(s), Title) 
'----------Done checking for duplicate------------- 
Else       'If no duplicate found, insert new row 
    'Set values 
    código.Value = ws1.Range("d4") 
    datarecebimento.Value = ws1.Range("H4") 
    tipo.Value = ws1.Range("b8") 
    textobrevematerial.Value = ws1.Range("D8") 
    codigopa.Value = ws1.Range("B12") 
    textobrevepa.Value = ws1.Range("D12") 
    ncm.Value = ws1.Range("B16") 
    versão.Value = ws1.Range("D16") 
    dataimpressão.Value = ws1.Range("F18") 
    datamkt.Value = ws1.Range("F20") 
    datarevisor.Value = ws1.Range("F22") 
    datasedev.Value = ws1.Range("M18") 
    dataar.Value = ws1.Range("M20") 
    datart.Value = ws1.Range("m22") 
    motivo1.Value = ws1.Range("B26") 
    motivo2.Value = ws1.Range("B30") 
    motivo3.Value = ws1.Range("B32") 
    dataremkt.Value = ws1.Range("F38") 
    dataresedev.Value = ws1.Range("M38") 
End If 

End Sub