EXCEL VBA 根據特定的字串把資料COPY到特定的SHEETS

Sub doWork()
'把年加到A欄位
'Worksheets(1).Activate
'For i = 2 To Worksheets(1).UsedRange.Rows.Count
'    If Val(Cells(i, 1)) < 2000 Then
'        Cells(i, 1) = "'2013/" & Cells(i, 1)
'    End If
'Next
'Exit Sub

'先把SHEETS刪除
 deleteSheets

'新增工作表出來
For i = 1 To 15
    Worksheets.Add after:=Worksheets("訂單記錄")
Next

'更改工作表名稱
'MsgBox Sheets.Count
For i = 2 To Sheets.Count
    'Sheets(i).Name = "AUS" '美國
    changeSheetsName (i)
Next

'把標題COPY到每一個SHEET去
Sheets(1).Select
Range("A1", "I1").Copy

For i = 2 To Sheets.Count
   
    Worksheets(i).Activate
    Range("A1").Select
    ActiveSheet.Paste
Next

'把資料依據客戶代碼放入相應的SHEETS
Worksheets(1).Activate
'MsgBox Worksheets(1).UsedRange.Rows.Count
For i = 2 To Worksheets(1).UsedRange.Rows.Count
   
    Sheets(1).Select
    Range("A" & i, "I" & i).Copy
   
    '判斷是什麼國家
    CC = checkCountry(Cells(i, 3))
    Worksheets(CC).Activate
    CCROWS = Worksheets(CC).UsedRange.Rows.Count + 1
    Range("A" & CCROWS).Select
    ActiveSheet.Paste
   
Next
End Sub



Sub deleteSheets()
Dim i As Integer
'關閉警告視窗
Application.DisplayAlerts = False
'刪除作用中的工作表
    For i = Sheets.Count To 2 Step -1
        Sheets(i).Delete
    Next
'恢復警告視窗
Application.DisplayAlerts = True

End Sub

Sub changeSheetsName(x As Integer)
   
    Select Case x
        Case 2
            Sheets(x).Name = "AUS(美國)"
        Case 3
            Sheets(x).Name = "EDME(德國)"
        Case 4
            Sheets(x).Name = "EBAE(英國)"
        Case 5
            Sheets(x).Name = "AMX(南美)"
        Case 6
            Sheets(x).Name = "EKLE(荷蘭)"
        Case 7
            Sheets(x).Name = "CSQ(新加坡)"
        Case 8
            Sheets(x).Name = "CEG(日本)"
        Case 9
            Sheets(x).Name = "AAC(加拿大)"
        Case 10
            Sheets(x).Name = "CCS(香港)"
        Case 11
            Sheets(x).Name = "ESD(瑞典)"
        Case 12
            Sheets(x).Name = "E(歐洲)"
        Case 13
            Sheets(x).Name = "UQF(大洋洲)"
        Case 14
            Sheets(x).Name = "C(亞洲)"
        Case 15
            Sheets(x).Name = "M(中東)"
        Case 16
            Sheets(x).Name = "Other(其他)"
    End Select
End Sub

Function checkCountry(x As String)
   
    checkCountry = 0
    'Select Case x
    '    Case 2
    '        Sheets(x).Name = "AUS" '美國
            If InStr(UCase(x), "AUS") > 0 Then checkCountry = 2
    '    Case 3
    '        Sheets(x).Name = "EDME" '德國
            If InStr(UCase(x), "EDME") > 0 Then checkCountry = 3
    '    Case 4
    '        Sheets(x).Name = "EBAE" '英國
            If InStr(UCase(x), "EBAE") > 0 Then checkCountry = 4
    '    Case 5
    '        Sheets(x).Name = "AMX" '南美
            If InStr(UCase(x), "AMX") > 0 Then checkCountry = 5
    '    Case 6
    '        Sheets(x).Name = "EKLE" '荷蘭
            If InStr(UCase(x), "EKLE") > 0 Then checkCountry = 6
    '    Case 7
    '        Sheets(x).Name = "CSQ" '新加坡
            If InStr(UCase(x), "CSQ") > 0 Then checkCountry = 7
    '    Case 8
    '        Sheets(x).Name = "CEG" '日本
            If InStr(UCase(x), "CEG") > 0 Then checkCountry = 8
    '    Case 9
    '        Sheets(x).Name = "AAC" '加拿大
            If InStr(UCase(x), "AAC") > 0 Then checkCountry = 9
    '    Case 10
    '        Sheets(x).Name = "CCS" '香港
            If InStr(UCase(x), "CCS") > 0 Then checkCountry = 10
    '    Case 11
    '        Sheets(x).Name = "ESD" '瑞典
            If InStr(UCase(x), "ESD") > 0 Then checkCountry = 11
    '    Case 12
    '        Sheets(x).Name = "E" '歐洲
            If checkCountry = 0 Then
                If InStr(UCase(x), "E") Then checkCountry = 12
    '    Case 13
    '        Sheets(x).Name = "UQF" '大洋洲
                If InStr(UCase(x), "UQF") Then checkCountry = 13
    '    Case 14
    '        Sheets(x).Name = "C" '亞洲
                If InStr(UCase(x), "C") Then checkCountry = 14
    '    Case 15
    '        Sheets(x).Name = "M" '中東
                If InStr(UCase(x), "M") Then checkCountry = 15
    '    Case 16
    '        Sheets(x).Name = "Other" '其他
                If checkCountry = 0 Then checkCountry = 16
            End If
    'End Select
End Function