Q：我在一個主工作表中導入并存放數據，想要將這些數據分別轉移到不同的工作表中，如所示，在工作表Data中存放著各超市的銷售數據，現在要將這些數據分別移至具有與超市名稱同名的工作表中，即“東區超市”中的數據全部移至工作表“東區超市”中，對于“北區超市”和“西區超市”也是如此。如何使用VBA代碼實現一次轉移數據？
A：可以使用下面的代碼實現，大多數代碼的功能見代碼中的注釋。
SubCopyDataToWorksheet()
‘聲明代表存放數據工作表的變量
Dim strSourceSheet As String
‘聲明代表要接收數據的工作表的變量
Dim strDestinationSheet As String
‘聲明代表工作表最后一行的變量
Dim lngLastRow As Long
‘存放數據的工作表名
strSourceSheet = “Data”
‘選取數據工作表
Sheets(strSourceSheet).Visible = True
Sheets(strSourceSheet).Select
‘選取與接收數據的工作表同名的單元格
Range(“B2″).Select
‘選取的單元格不為空,則繼續循環
Do While ActiveCell.Value <>””
‘當前單元格值賦給工作表名變量
strDestinationSheet = ActiveCell.Value
‘選取當前單元格所在的數據行
ActiveCell.Offset( , -1).Resize(1,ActiveCell.CurrentRegion.Columns.Count).Select
‘復制數據行
Selection.Copy
‘選取接收數據的工作表
Sheets(strDestinationSheet).Visible =True
Sheets(strDestinationSheet).Select
‘獲取當前工作表最后一行
lngLastRow =LastRowInOneColumn(“A”)
‘選取工作表最后一行之后的空單元格
Cells(lngLastRow + 1, 1).Select
‘粘貼數據
Selection.PasteSpecial xlPasteValues
‘去除復制后單元格框外的虛線
Application.CutCopyMode = False
‘選取數據工作表成為當前工作表
Sheets(strSourceSheet).Select
‘將當前單元格移至下一個與接收數據的工作表同名的單元格
ActiveCell.Offset(1, 1).Select
Loop
End Sub
‘獲取工作表中最后一行行號
Public FunctionLastRowInOneColumn(col)
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count,col).End(xlUp).Row
End With
LastRowInOneColumn = lastRow
End Function
說明：在示例工作表Data中，我們將各個超市分別放在一起。在實際導入數據時，如果相同名稱的數據不在一起也沒有關系。當然，你可以使用排序功能將它們放置在一起。
