軟體:office excel
版本:2010
各位先進前輩好，因為剛開始著手練習寫excel vba
本身對於程式語言是完全沒有概念，也沒有基礎
在網路東湊西湊之後，是寫出了符合自己需求又勉強堪用的功能了
但是因為完全不懂也沒接觸過，不曉得該從哪邊去簡化其寫法，說明如下…。
事情是這樣子的，因為資料整理的需求，所以我需要寫出一個功能
先針對某個欄位設定為下拉式選單（純excel的資料驗證），其內容是地區，像是台北、
桃園、新竹、……等地區。
然後每個地區有自己的分頁，當我選定好地區（ex：台中），然後再按下按鍵
就可以自動執行動態複製，也就是複製某些欄位的數據到台中分頁的某欄，如遇有資料就自動
往同欄的下一列存放資料，並且是以單純貼上值的方式完成，並且清除已選取的效果
如下所示，d5跟f1是我想做動態複製的資料，土法練鋼，寫的很亂，請各位先進前輩不吝
指點，讓我可以用更精簡的方式去完成這個功能，感謝。
Sub test_Click()
Dim x As Long
Dim lastrow1 As Long
Dim sh1, sh2, sh3, sh4, sh5, sh6, sh7, sh8, sh9, sh10, sh11, sh12, sh13,
sh14, sh15, sh16, sh17, sh18 As Worksheet
[f1] = ([d2] & "," & " " & [d3])
Set sh1 = Sheets("查詢")
Set sh2 = Sheets("台南")
Set sh3 = Sheets("高雄")
Set sh4 = Sheets("屏東")
Set sh5 = Sheets("嘉義")
Set sh6 = Sheets("雲林")
Set sh7 = Sheets("南投")
Set sh8 = Sheets("彰化")
Set sh9 = Sheets("台中")
Set sh10 = Sheets("苗栗")
Set sh11 = Sheets("新竹")
Set sh12 = Sheets("桃園")
Set sh13 = Sheets("新北")
Set sh14 = Sheets("台北")
Set sh15 = Sheets("基隆")
Set sh16 = Sheets("台東")
Set sh17 = Sheets("花蓮")
Set sh18 = Sheets("宜蘭")
lastrow1 = sh2.Range("c65536:d65536").End(xlUp).Row
lastrow2 = sh3.Range("c65536:d65536").End(xlUp).Row
lastrow3 = sh4.Range("c65536:d65536").End(xlUp).Row
lastrow4 = sh5.Range("c65536:d65536").End(xlUp).Row
lastrow5 = sh6.Range("c65536:d65536").End(xlUp).Row
lastrow6 = sh7.Range("c65536:d65536").End(xlUp).Row
lastrow7 = sh8.Range("c65536:d65536").End(xlUp).Row
lastrow8 = sh9.Range("c65536:d65536").End(xlUp).Row
lastrow9 = sh10.Range("c65536:d65536").End(xlUp).Row
lastrow10 = sh11.Range("c65536:d65536").End(xlUp).Row
lastrow11 = sh12.Range("c65536:d65536").End(xlUp).Row
lastrow12 = sh13.Range("c65536:d65536").End(xlUp).Row
lastrow13 = sh14.Range("c65536:d65536").End(xlUp).Row
lastrow14 = sh15.Range("c65536:d65536").End(xlUp).Row
lastrow15 = sh16.Range("c65536:d65536").End(xlUp).Row
lastrow16 = sh17.Range("c65536:d65536").End(xlUp).Row
lastrow17 = sh18.Range("c65536:d65536").End(xlUp).Row
If sh1.Range("d5") = "unknow" Then Exit Sub
If sh1.Range("d4") = "" Then Exit Sub
sh1.Range("d5").Copy
If sh1.Range("d4") = "台南" Then
sh2.Range("c" & lastrow1 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh2.Range("d" & lastrow1 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "高雄" Then
sh3.Range("c" & lastrow2 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh3.Range("d" & lastrow2 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "屏東" Then
sh4.Range("c" & lastrow3 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh4.Range("d" & lastrow3 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "嘉義" Then
sh5.Range("c" & lastrow4 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh5.Range("d" & lastrow4 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "雲林" Then
sh6.Range("c" & lastrow5 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh6.Range("d" & lastrow5 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "南投" Then
sh7.Range("c" & lastrow6 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh7.Range("d" & lastrow6 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "彰化" Then
sh8.Range("c" & lastrow7 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh8.Range("d" & lastrow7 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "台中" Then
sh9.Range("c" & lastrow8 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh9.Range("d" & lastrow8 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "苗栗" Then
sh10.Range("c" & lastrow9 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh10.Range("d" & lastrow9 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "新竹" Then
sh11.Range("c" & lastrow10 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh11.Range("d" & lastrow10 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "桃園" Then
sh12.Range("c" & lastrow11 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh12.Range("d" & lastrow11 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "新北" Then
sh13.Range("c" & lastrow12 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh13.Range("d" & lastrow12 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "台北" Then
sh14.Range("c" & lastrow13 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh14.Range("d" & lastrow13 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "基隆" Then
sh15.Range("c" & lastrow14 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh15.Range("d" & lastrow14 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "台東" Then
sh16.Range("c" & lastrow15 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh16.Range("d" & lastrow15 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "花蓮" Then
sh17.Range("c" & lastrow16 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh17.Range("d" & lastrow16 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
If sh1.Range("d4") = "宜蘭" Then
sh18.Range("c" & lastrow17 + 1).PasteSpecial Paste:=xlPasteValues
sh1.Range("f1").Copy
sh18.Range("d" & lastrow17 + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
[f1] = ""
End If
End Sub
以上，請惠予指導如何可以用更精簡的方式去完成，再次感謝。
如有不小心違反版規規定，請告知，定當立即刪除。