VBA如何從第一個單元格/列循環（強制它）

Question

下面是我的代碼，我試圖強制檢查從第一個單元格開始，但它不起作用。任何人都可以就此提醒我。謝謝

我想檢查工作簿A的第3列上的名稱，並將它與另一個工作簿中的另一列進行比較。在弦上的比賽，這將某些單元格複製到脫鹽柱

Sub copyandpaste() 

Set From_WS = Workbooks("copy_data2").Worksheets("Data") 
Set To_WS = Workbooks("Book1").Worksheets("Sheet1") 
Dim v1 As String 
Dim v2 As String 
Dim diffRow As Long 
Dim dataWs As Worksheet 
Dim copyWs As Worksheet 
Dim rowData As Long 
Dim totRows As Long 
Dim lastRow As Long 
Dim result As String 
Dim row_no As Integer 
Dim Name As Range 
Dim Namelist As Range 
diffRow = 1 'compare 
Set dataWs = Worksheets("Data") 
Set copyWs = Worksheets("Diff") 


For Each c In Worksheets("Data").Range("C2:C10") 
    If c.Value <> "" Then 
    v1 = c 
End If 

For Each d In Workbooks("Book1").Worksheets("Sheet1").Range("B2:B10") 
    If d.Value <> "" Then 
    v2 = d 
End If 


With From_WS.Cells(1, 2).CurrentRegion 
    Total_Rows = .Rows.Count 
    Total_Columns = .Columns.Count 
End With 

Set mycellA = From_WS.Range("C:C") 
Set mycellB = To_WS.Range("B:B") 


Copy = False 

     ' With Sheets("copy_data2") 
     ' lastRow = .Range("A" & .Rows.Count).End(xlUp).Row 

     'find first row 
     'column1 = Range("A2").End(xlToRight).Column 


     'For row_no = 1 To 10 
    '========================================================================= 

    Set Namelist = dataWs.Range("A1:A" & dataWs.Cells(Rows.Count, "A").End(xlUp).Row) 

    'Now loop through all the cells in the range 
    'For Each Name In Namelist.Cells 

    mynumber = 1 
    For Each Name In Namelist 
    '======================================================================= 
     If v1 = v2 Then 

     'select sheet 
     Sheets("Data").Select 

     'ActiveCell.Select 'select active cell 
     ActiveCell.Interior.ColorIndex = 36 'color the cell 

     'copy active cell same row 
     ActiveCell.Range("A1:F1").Copy 
     ActiveCell.Interior.ColorIndex = 50 'color the cell 

     'Paste file destination 
     Sheets("Diff").Select 

     Sheets("Diff").Range("A2").Select 

     'Paste Active 
     ActiveSheet.Paste 
     ActiveCell.Interior.ColorIndex = 37 '<< Colored Blue 
     '================================================================== 
     'select sheet 
     Sheets("Data").Select 

     'ActiveCell.Select 'select active cell 
     ActiveCell.Interior.ColorIndex = 36 'color cell Yellow 

     'result = ActiveCell.EntireRow.copy 

     'copy active cell same row 
     ActiveCell.Range("H1:J1").Copy 

     'Paste file destination 
     Sheets("Diff").Select 

     'Paste cell destination 
     Sheets("Diff").Range("G2").Select 

     'Paste Active 
     ActiveSheet.Paste 
     mynumber = mynumber + 1 
    End If 
    Next Name 



Next d 
Next c 


End Sub 

這是第二個函數，計算並辦理行。

Sub RoundToZero1() 
    For Counter = 1 To 20 
     Set curCell = Worksheets("Data").Cells(Counter, 3) 
     If Abs(curCell.Value) < 0.01 Then curCell.Value = 0 
    Next Counter 
End Sub 

更新問題：

我有下面的代碼，我需要讓該列的是增量。任何人都有建議如何實現這一目標？

Sheets("Diff").Range("A").Select 

Answer 1

線Set selectedCell = selectedCell + 1當我運行它並沒有出現做任何事情的代碼，如果是這樣的話，你應該把它註釋掉或刪除它拋出一個錯誤。

此外我認爲你需要改變

Else 
If IsEmpty(Cells(i, 1)) = True Then 'if cells in column "A" is empty then stop 

到

ElseIf IsEmpty(Cells(i, 1)) = True Then 'if cells in column "A" is empty then stop 

目前的情況是你有一個額外開放的if語句。