vba自動フィルタリングして別のシートに結果をコピーする：正しい範囲をコピーできない

Question

シートANAF CONTURI（カラムG3の基準、G10000）の情報をフィルタリングし、 A3：F3から降りて）C2：H2からANAF BANCIに入り、降ります。

問題：ANAF CONTURIシートに何も情報を入力しないと、A3の場合は、その行から何もコピーされません（条件が一致していてもF3までその行の残りのセルがあります）。データ）。

セルB3にデータがない場合、行の残りの部分は無関係ですが、セルA3だけが考慮されるため、セルB3でこれを行っていればOKです。

解決策は何ですか。

Private Sub CommandButton1_Click() 
' TRIAZA INFORMATIA INTRODUSA SI O INAINTEAZA SPRE PRELUCRARE IN ANAF BANCI 

    Application.ScreenUpdating = False 

    Sheet8.Unprotect Password:="online07" 
    Sheets("ANAF BANCI").Range("C2:H1000").ClearContents 

    With Sheets("ANAF CONTURI") '<--| reference your sheet   
    With .Range("G2", .Cells(.Rows.Count, 1).End(xlUp)) '<--| reference its column "A:G" range from row 1 down to column "A" last not empty row 

     .AutoFilter Field:=7, Criteria1:="Da" ''<--| filter referenced range on its 7th column (i.e. column "G") with "Da" values 
     If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.Count - 1, 6).Offset(1).SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("ANAF BANCI").Range("C2") 
    End With  

    If (Sheets("ANAF CONTURI").AutoFilterMode And Sheets("ANAF CONTURI").FilterMode) Or Sheets("ANAF CONTURI").FilterMode Then 
     Sheets("ANAF CONTURI").ShowAllData 
    End If 
    End With 

    Sheet8.Range("A3:F20000").Locked = False 
    Sheet8.Protect Password:="online07" 

    ' SortareAlaZ Macro 
    ActiveWorkbook.Worksheets("- - REZULTAT ANAF - -").AutoFilter.Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("- - REZULTAT ANAF - -").AutoFilter.Sort.SortFields. _ 
     Add Key:=Range("O3:O16571"), SortOn:=xlSortOnValues, Order:=xlAscending, _ 
     DataOption:=xlSortNormal 
    With ActiveWorkbook.Worksheets("- - REZULTAT ANAF - -").AutoFilter.Sort 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 

    Application.ScreenUpdating = True 

End Sub 

Answer 1

私は同じことを動作しない別の方法を見つけました：

Dim src As Worksheet 
    Dim tgt As Worksheet 
    Dim filterRange As range 
    Dim copyRange As range 
    Dim lastRow As Long 

    Set src = ThisWorkbook.Sheets("ANAF CONTURI") 
    Set tgt = ThisWorkbook.Sheets("ANAF BANCI") 

    ' turn off any autofilters that are already set 
    src.AutoFilterMode = False 

    ' find the last row with data in column A 
    lastRow = src.range("B" & src.Rows.Count).End(xlUp).Row 

    ' the range that we are auto-filtering (all columns) 
    Set filterRange = src.range("A2:G" & lastRow) 

    ' the range we want to copy (only columns we want to copy) 
    ' in this case we are copying country from column A 
    ' we set the range to start in row 2 to prevent copying the header 
    Set copyRange = src.range("A3:F" & lastRow) 

    ' filter range based on column B 
    filterRange.AutoFilter Field:=7, Criteria1:="Da" 

    ' copy the visible cells to our target range 
    ' note that you can easily find the last populated row on this sheet 
    ' if you don't want to over-write your previous results 
    copyRange.SpecialCells(xlCellTypeVisible).Copy tgt.range("C2") 



      If (Sheets("ANAF CONTURI").AutoFilterMode And Sheets("ANAF CONTURI").FilterMode) Or Sheets("ANAF CONTURI").FilterMode Then 
    Sheets("ANAF CONTURI").ShowAllData 
    End If