將資料複製到不同的工作表

1^# 跳轉到 »

發表於 2012-12-10 20:17 | 顯示全部帖子

本帖最後由 stillfish00 於 2012-12-10 20:20 編輯

回復 1# fangsc
參考看看下面程式 , 但其實資料量若是很大的話不是很建議直接在Worksheet_Change事件內去處理

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim r As Long
Dim sales As String
Application.ScreenUpdating = False
'clear header
For Each ws In Sheets
If not ws is Me Then
ws.UsedRange.Offset(1).ClearContents
End If
Next
For r = 2 To Range("C" & Rows.Count).End(xlUp).Row
sales = Cells(r, "C").Value
If sales <> "" Then
If Not hasSheet(sales) Then
With Sheets.Add(After:=Sheets(Sheets.Count))
.name = sales
[A1:H1].Copy .[A1]
End With
End If
With Sheets(sales)
.Range("C" & .Rows.Count).End(xlUp).Offset(1, -2).Resize(1, 8) = Range("A" & r & ":" & "H" & r).Value
End With
End If
Next r
Me.Select
Application.ScreenUpdating = True
End Sub
Function hasSheet(name As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Sheets(name)
On Error GoTo 0
If ws Is Nothing Then
hasSheet = False
Else
hasSheet = True
End If
Set ws = Nothing
End Function

複製代碼

靜思自在 : 心中常存善解、包容、感思、知足、惜福。