macro 9/24

Sub table99()
    Dim inputRow, outputRow As Integer
    Dim fromSheet, toSheet As Worksheet
    Dim wsSetup As Worksheet
    Dim i, j As Integer
    Dim LR, NR As Long
    Dim col1, col2 As Long
    Dim fromCol, toCol As Long
    Dim strFind As String
    
    Set wsSetup = Excel.Worksheets("Setup")
    Set toSheet = Excel.Worksheets(wsSetup.Cells(6, 2).Value)
    strFind = wsSetup.Cells(14, 2).Value
    
    Set fromSheet = ThisWorkbook.Sheets(wsSetup.Cells(5, 2).Value)
    LR = toSheet.Range("C" & Rows.Count).End(xlUp).Row
    NR = fromSheet.Range("C" & Rows.Count).End(xlUp).Row
    
    col1 = fromSheet.UsedRange.Columns.Count
    col2 = toSheet.UsedRange.Columns.Count
    Do While 1
        If fromSheet.Cells(1, col1).Value = "" Then
            col1 = col1 - 1
        Else
            Exit Do
        End If
    Loop
    Do While 1
        If toSheet.Cells(2, col2).Value = "" Then
            col2 = col2 - 1
        Else
            Exit Do
        End If
    Loop
    
    
    For i = 1 To col1
        If LCase(fromSheet.Cells(1, i).Value) = LCase(strFind) Then
            fromCol = i
            Exit For
        End If
    Next i
    For i = 1 To col2
        If LCase(toSheet.Cells(2, i).Value) = LCase(strFind) Then
            toCol = i
            Exit For
        End If
    Next i


    inputRow = fromCol
    outputRow = toCol
    
    If LCase(toSheet.Cells(2, outputRow).Value) <> LCase(fromSheet.Cells(1, inputRow).Value) Then
        MsgBox (toSheet.Cells(2, outputRow).Value & "!=" & fromSheet.Cells(1, inputRow).Value)
    Else
    For j = 2 To NR
        fromSheet.Cells(j, 2).Interior.Color = RGB(255, 0, 6)
        For i = 2 To LR
            If fromSheet.Cells(j, 3).Value = toSheet.Cells(i, 3).Value Then
                fromSheet.Cells(j, 2).Value = i & "Row"
                fromSheet.Cells(j, 2).Interior.Color = RGB(255, 255, 255)
                toSheet.Cells(i, outputRow).Value = fromSheet.Cells(j, inputRow).Value
                Exit For
            End If
        Next i
    Next j

    End If

    MsgBox ("OK")
End Sub
'Sub numberrow()
'    Dim inputStr As String
'    inputStr = "GW"
'    MsgBox (Val(inputStr))
Sub Sample()
    Dim ColName As String
    
    ColName = "C"
    MsgBox (Range(ColName & 1).Column)
End Sub

Sub copy_table()
    Dim inputRow, outputRow As Integer
    Dim fromSheet, toSheet As Worksheet
    Dim wsSetup As Worksheet
    Dim LR, NR, col1, col2 As Integer
    Dim i, j As Integer
        
    Set wsSetup = Excel.Worksheets("Setup")
    Set fromSheet = Excel.Worksheets(wsSetup.Cells(5, 2).Value)
    Set toSheet = Excel.Worksheets(wsSetup.Cells(6, 2).Value)
    outputRow = Range(wsSetup.Cells(6, 3).Value & 1).Column
    inputRow = Range(wsSetup.Cells(5, 3).Value & 1).Column
    
    LR = toSheet.Range("C" & Rows.Count).End(xlUp).Row
    NR = fromSheet.Range("C" & Rows.Count).End(xlUp).Row

    If LCase(toSheet.Cells(2, outputRow).Value) <> LCase(fromSheet.Cells(1, inputRow).Value) Then
        MsgBox (toSheet.Cells(2, outputRow).Value & "!=" & fromSheet.Cells(1, inputRow).Value)
    Else
    For j = 2 To NR
        fromSheet.Cells(j, 2).Interior.Color = RGB(255, 0, 6)
        For i = 2 To LR
            If fromSheet.Cells(j, 3).Value = toSheet.Cells(i, 3).Value Then
                fromSheet.Cells(j, 2).Value = i & "Row"
                fromSheet.Cells(j, 2).Interior.Color = RGB(255, 255, 255)
                toSheet.Cells(i, outputRow).Value = fromSheet.Cells(j, inputRow).Value
                Exit For
            End If
        Next i
    Next j

    End If

    MsgBox ("OK")
End Sub


Sub DATAUPDATE()
    Dim ws As Worksheet, q As QueryTable
    
    For Each ws In ActiveWorkbook.Worksheets
        For Each q In ws.QueryTables
            q.Refresh (False)
        Next
    Next
End Sub

http://stackoverflow.com/questions/2538449/excel-macro-to-create-sheets