-1

Below are my codes, I am trying to force the checking to start from the first cell, but it doesn't work. Can anyone advise me on that. Thanks

I am trying to do checking on the names which is on the 3rd column of Workbook A and compare it with the other column in another workbook. Upon match of the string, it will copy certain cells to the desalinated column 

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

This is the second function, to count and go through the rows.

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

Update Question:

I have the code below, I need to make the column A to be incremental. Anyone have suggestion how to achieve that?

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

1 回答 1

0

该行在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 语句。

于 2013-08-22T20:15:56.757 回答