VBAは3つのセルの範囲をコピーして別のファイルに保存します範囲をインクリメントするにはどうすればいいですか

Question

私のVBAコードは、バーコードをスキャンしてセルA1に3つの情報B1およびC1。その周りの最初の時間はうまく動作しますが、私はその行の上でそれをしようとした後、それは動作しません。私はそれが私が選択している範囲と関係があると知っていますが、範囲を増やす方法はわかりません。私は右のデータが正しいファイルに保存された文字列のいずれかによってトリガなっ別の番号があるたびに動作するようにこれが必要

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim String_1 As String 
Dim String_2 As String 
Dim String_3 As String 

String_1 = "400" 
String_2 = "401" 
String_3 = "402" 

If Len(Range("A1").Value) > 0 And Len(Range("B1").Value) > 0 And Len(Range("C1").Value) > 0 Then 

Dim sComp As String 
sComp = Left(Range("C1"), 3) 

If sComp = String_1 Or sComp = String_2 Or sComp = String_3 Then 

    Range("A1:C1").Copy 
    Dim wbCopy As Workbook 
    Set wbCopy = Workbooks.Add 

    With wbCopy 
     .Sheets(1).Range("A1").PasteSpecial xlPasteValues 
     Application.DisplayAlerts = False 
     .SaveAs Filename:="u:\CSV\Diepunch" & sComp & ".csv", FileFormat:=xlCSV, CreateBackup:=False 
     Application.DisplayAlerts = True 
     .Close False 

    End With 

    End If 

End If 

End Sub 

：これは、これまでの私のコードです。誰でもこのヒントやヒントを修正する方法についての洞察はありますか？助けに感謝します。

Answer 1

データを貼り付けるには、次の空の行を見つける必要があります。

 
Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim String_1 As String 
    Dim String_2 As String 
    Dim String_3 As String 
    Dim newRow As Long 
    String_1 = "400" 
    String_2 = "401" 
    String_3 = "402" 

    If Len(Range("A1").Value) > 0 And Len(Range("B1").Value) > 0 And Len(Range("C1").Value) > 0 Then 

     Dim sComp As String 
     sComp = Left(Range("C1"), 3) 

     If sComp = String_1 Or sComp = String_2 Or sComp = String_3 Then 

      Range("A1:C1").Copy 
      Dim wbCopy As Workbook 
      Set wbCopy = Workbooks.Add 

      With wbCopy 
       newRow = .Range("A1").End(xlUp).Row + 1 
       .Sheets(1).Cells(newRow, 1).PasteSpecial xlPasteValues 
       Application.DisplayAlerts = False 
       .SaveAs Filename:="u:\CSV\Diepunch" & sComp & ".csv", FileFormat:=xlCSV, CreateBackup:=False 
       Application.DisplayAlerts = True 
       .Close False 

      End With 

     End If 

    End If 

End Sub 

Answer 2

あなたが更新した後、新しいデータを追加するために、その最後の行を見つけるためにCSVファイルの存在のために両方のチェックが

迅速かつ汚い修正する必要があります。

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim String_1 As String 
    Dim String_2 As String 
    Dim String_3 As String 
    Dim myFileName As String 

    Dim wbCopy As Workbook 
    Dim lastRow As Long 

    String_1 = "400" 
    String_2 = "401" 
    String_3 = "402" 

    If Len(Range("A1").Value) > 0 And Len(Range("B1").Value) > 0 And Len(Range("C1").Value) > 0 Then 

     Dim sComp As String 
     sComp = Left(Range("C1"), 3) 

     If sComp = String_1 Or sComp = String_2 Or sComp = String_3 Then 
'   myFileName = "u:\CSV\Diepunch" & sComp & ".csv" 
      Range("A1:C1").Copy 

      Application.ScreenUpdating = False 
      If Dir(myFileName) = "" Then 
       Set wbCopy = Workbooks.Add 
      Else 
       Set wbCopy = Workbooks.Open(myFileName) 
      End If 

      With wbCopy 
       With .Sheets(1) 
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 
        If .Cells(lastRow, 1).Value <> "" Then lastRow = lastRow + 1 
        .Cells(lastRow, 1).PasteSpecial xlPasteValues 
       End With 
       Application.DisplayAlerts = False 
       .SaveAs Filename:=myFileName, FileFormat:=xlCSV, CreateBackup:=False 
       Application.DisplayAlerts = True 
       .Close False 
      End With 

      Application.ScreenUpdating = True 
     End If 

    End If 

End Sub