Re: [算表] 將特定條件的儲存格輸出成多個檔案--VBA
剛才看了一下，才發現前一個回答，是拿中間 wengo 問的程式來改說，
原來是改錯了說 ^_^
重新用之前的檔案修改成你要的囉，看看有無問題！
Option Explicit
Sub Macro1()
Dim rCount As Integer
Dim curdir As String
Dim i As Integer, j As Integer
Dim wbNew As Workbook
Dim flag() As Boolean
Dim rangeStr As String
'不要問要不要覆蓋檔案
Application.DisplayAlerts = False
curdir = ThisWorkbook.Path & Application.PathSeparator
With ThisWorkbook.Sheets(1)
'計算多少筆資料
rCount = .Cells(.Rows.Count, 1).End(xlUp).Row
ReDim flag(rCount)
For i = 2 To rCount
rangeStr = "1:1"
If flag(i) = False Then '檢查是否有處理過
flag(i) = True
rangeStr = rangeStr & "," & i & ":" & i
For j = i + 1 To rCount '將相同名稱的串起來
If (flag(j) = False) And (Cells(i, 1) = Cells(j, 1)) Then
rangeStr = rangeStr & "," & j & ":" & j
flag(j) = True
End If
Next j
Set wbNew = Workbooks.Add
.Range(rangeStr).EntireRow.Copy
wbNew.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbNew.Sheets(1).Cells(1, 1).Select
wbNew.Close SaveChanges:=True, Filename:=curdir & .Cells(i, 1) & ".xls"
End If
Next i
End With
Sheets(1).Select
Cells(1, 1).Select
Application.CutCopyMode = False
MsgBox ("成功")
End Sub
※ 引述《ljuber (給你吃膨餅)》之銘言：
: ※ 引述《windknife18 (windknife18)》之銘言：
: 如果是說 要連儲存格裡面有公式的也一起貼過去
: 這有辦法嗎???XD
: 好像要求有點多 哈XD
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 61.229.72.161
→
04/28 13:59, , 1F
04/28 13:59, 1F
推
04/28 15:10, , 2F
04/28 15:10, 2F
→
04/29 09:45, , 3F
04/29 09:45, 3F
推
04/29 14:35, , 4F
04/29 14:35, 4F
→
04/29 14:42, , 5F
04/29 14:42, 5F
推
04/29 15:10, , 6F
04/29 15:10, 6F
→
04/29 15:11, , 7F
04/29 15:11, 7F
推
04/29 15:12, , 8F
04/29 15:12, 8F
→
04/29 15:13, , 9F
04/29 15:13, 9F
→
04/29 15:17, , 10F
04/29 15:17, 10F
→
04/29 15:18, , 11F
04/29 15:18, 11F
→
04/29 15:18, , 12F
04/29 15:18, 12F
推
04/29 20:08, , 13F
04/29 20:08, 13F
→
04/29 20:09, , 14F
04/29 20:09, 14F
討論串 (同標題文章)
Office 近期熱門文章
PTT數位生活區 即時熱門文章
