条件/条件が満たされている場合に別のワークブックにデータをコピー

Question

これは何度もここに尋ねられている場合はごめんなさい。私はvbaの初心者ですので、コードをどのように始めるかという簡単なアイデアがあります。私はExcel 2013を使用しています。

私は2つの異なるワークブック、メインとコピーを持っています。 行1〜4は空になります。 行5は、両方のワークブックに提供される情報のヘッダー/ラベリング用です。

「メイン」ワークブックは、列AからDNを使用してすべてのデータを格納します。

セルに「X」が含まれている場合は、列AをPに、ワークブック「コピー」にコピーします。その後、同じ行を決定するために次の行に進みます。 セルが空の場合は、同じ行を決定するためにセルが次の行に進みます。 新しい行が追加されたり、「X」から空に、または「X」に空に変更されるなど、新しい情報が3か月ごとに追加されるため、コードは動的でなければなりません。

これは私が今のところ持っているコードです。 それは動作しますが、チェックする列が非常に多いので、私はこのために別のコードを実行することを勧めました。そのために

Sub copy() 
 
Dim lr As Long, lr2 As Long, r As Long 
 
lr = Sheets("main").Cells(Rows.Count, "A").End(xlUp).row 
 
lr2 = Sheets("copy").Cells(Rows.Count, "A").End(xlUp).row 
 
For r = lr To 2 Step -1 
 
    If range("Q" & r).Value = "X" Then 
 
     Rows(r).copy Destination:=Sheets("copy").range("A" & lr2 + 1) 
 
     lr2 = Sheets("copy").Cells(Rows.Count, "A").End(xlUp).row 
 
    End If 
 
Next r 
 
End Sub

Answer 1

あなたは、コード内で送信元と送信先のワークブックとワークシートの参照を保持するために、2つのワークブック変数と2つのワークシートの変数を宣言する必要があります。

要件に応じて次のコードを調整します。

私はプログラムの流れを理解するのに役立つコメントをコードに追加しました。

さらに、エラー処理を使用して、ソースと宛先のシートがそれぞれソースブックと宛先のブックにあることを確認できます。 必要に応じて、エラー処理も追加できます。

Option Explicit 

Sub CopyDatoToAnotherWorkbook() 
Dim srcWB As Workbook, destWB As Workbook  'Variables to hold the source and destination workbook 
Dim srcWS As Worksheet, destWS As Worksheet  'Variables to hold the source and destination worksheets 
Dim FilePath As String       'Variable to hold the full path of the destination workbook including it's name with extension 
Dim lr As Long, lr2 As Long, r As Long 

Application.ScreenUpdating = False 

Set srcWB = ThisWorkbook      'Setting the source workbook 
Set srcWS = srcWB.Sheets("main")    'Setting the source worksheet 

'Setting the FilePath of the destination workbook 
'The below line assumes that the destination file's name is MyFile.xlsx and it is saved at your desktop. Change the path as per your requirement 
FilePath = Environ("UserProfile") & "\Desktop\MyFile.xlsx" 

'Cheching if the destination file exists, it yes, proceed with the code else EXIT 
If Dir(FilePath) = "" Then 
    MsgBox "The file " & FilePath & " doesn't exist!", vbCritical, "File Not Found!" 
    Exit Sub 
End If 
'Finding the last row used in column A on source worksheet 
lr = srcWS.Cells(Rows.Count, "A").End(xlUp).Row 

'Opening the destination workbook and setting the source workbook 
Set destWB = Workbooks.Open(FilePath) 

'Setting the destination worksheet 
Set destWS = destWB.Sheets("copy") 

'Looping through rows on source worksheets 
For r = lr To 2 Step -1 
    'Finding the first empty row in column A on destination worksheet 
    lr2 = destWS.Cells(Rows.Count, "A").End(xlUp).Row + 1 

    If srcWS.Range("Q" & r).Value = "X" Then 
     srcWS.Rows(r).copy Destination:=destWS.Range("A" & lr2 + 1) 
    End If 
Next r 

'Closing the destination workbook 
destWB.Close True 
Application.CutCopyMode = False 
Application.ScreenUpdating = True 
End Sub