软件: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
以上，请惠予指导如何可以用更精简的方式去完成，再次感谢。
如有不小心违反版规规定，请告知，定当立即删除。