Re: [算表] 將特定條件的儲存格輸出成多個檔案--VBA
不會阿，修改一下就可以符合你的需求，和樂而不為呢 ^_^
Option Explicit
Sub Macro1()
Dim i As Integer, j As Integer, rCount As Integer
Dim firstr As Integer, lastr As Integer
Dim rangeStr As String
'不要問要不要覆蓋檔案
Application.DisplayAlerts = False
'先清掉其他 sheets
For i = ThisWorkbook.Sheets.Count To 2 Step -1
ThisWorkbook.Sheets(i).Delete
Next i
With ThisWorkbook
'計算多少筆資料
rCount = Sheets(1).Cells(Sheets(1).Rows.Count, 1).End(xlUp).Row
i = 2
While i <= rCount
j = i + 1
rangeStr = "1:1"
While (Sheets(1).Cells(j, 1) = Sheets(1).Cells(i, 1)) And (j <= rCount)
j = j + 1
Wend
If (j = rCount + 1) Then
rangeStr = rangeStr & "," & i & ":" & j
Else
rangeStr = rangeStr & "," & i & ":" & (j - 1)
End If
.Sheets.Add After:=Sheets(Sheets.Count)
.Sheets(Sheets.Count).Name = .Sheets(1).Cells(i, 1)
.Sheets(1).Range(rangeStr).EntireRow.Copy
'主要是這二行
Sheets(Sheets.Count).Range("A1").PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
i = j
Wend
End With
ThisWorkbook.Sheets(1).Select
Cells(1, 1).Select
Application.CutCopyMode = False
MsgBox ("成功")
End Sub
※ 引述《ljuber (給你吃膨餅)》之銘言：
: ※ 引述《windknife18 (windknife18)》之銘言：
: 如果是說 要連儲存格裡面有公式的也一起貼過去
: 這有辦法嗎???XD
: 好像要求有點多 哈XD
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 140.131.84.79
推
04/27 13:24, , 1F
04/27 13:24, 1F
→
04/27 13:36, , 2F
04/27 13:36, 2F
推
04/27 13:47, , 3F
04/27 13:47, 3F
→
04/27 14:38, , 4F
04/27 14:38, 4F
推
04/27 16:31, , 5F
04/27 16:31, 5F
→
04/27 16:33, , 6F
04/27 16:33, 6F
→
04/27 16:33, , 7F
04/27 16:33, 7F
推
04/27 17:27, , 8F
04/27 17:27, 8F
討論串 (同標題文章)
本文引述了以下文章的的內容：
完整討論串 (本文為第 8 之 12 篇)：
Office 近期熱門文章
PTT數位生活區 即時熱門文章
