[發問] VBA 如何將選取的資料, 貼在不同sheet上

你好
以下是從此網站上來的........

第一段程式段OK但.......

Sub 加入檔案()
fds = Application.GetOpenFilename("Excel Files (*.xls;*.xlsx), *.xls;*.xlsx", , , , True)
If IsArray(fds) Then
For i = 1 To UBound(fds)
[A1].Offset(i - 1) = fds(i)
Next
End If
End Sub

請問在執行時如果要選擇性的將檔案貼到指定的sheet上(不同sheet)
以下執行程式要怎麼改寫
(原本以下程式只是將開啟的資料貼在同sheet上,
Sub 執行()
For Each a In Range([A1], Cells(Rows.Count, 1).End(xlUp))
  With Workbooks.Open(a)
   .Sheets(1).[A1:C6].Copy ThisWorkbook.Sheets("Result").Cells(Rows.Count, 1).End(xlUp).Offset(1)
   .Close 0
  End With
Next
End Sub
謝謝

樓主熱帖

Ian

iverson105

小學生 Rank: 1

帖子: 27
主題: 11
精華: 0
積分: 38
點名: 0
作業系統: window
軟體版本: window7
閱讀權限: 10
性別: 男
註冊時間: 2019-12-12
最後登錄: 2021-4-21

2^#

發表於 2019-12-24 08:54 | 只看該作者

各位大大
有人可幫忙回復嗎
就是說
1.我利用以下的程式碼(加入檔案)
結果是ok!它可將選取的檔案路徑餮在excel 上

2.第二段(執行)
結果是已選取的檔案開啟後,會自動往下貼在同一sheet中

3.我希望在開啟檔案路徑後,在執行時可將檔案放在不同sheets

求解各位大大
第一段程式段OK但.......

Sub 加入檔案()
fds = Application.GetOpenFilename("Excel Files (*.xls;*.xlsx), *.xls;*.xlsx", , , , True)
If IsArray(fds) Then
For i = 1 To UBound(fds)
[A1].Offset(i - 1) = fds(i)
Next
End If
End Sub

請問在執行時如果要選擇性的將檔案貼到指定的sheet上(不同sheet)
以下執行程式要怎麼改寫
(原本以下程式只是將開啟的資料貼在同sheet上,
Sub 執行()
For Each a In Range([A1], Cells(Rows.Count, 1).End(xlUp))
  With Workbooks.Open(a)
   .Sheets(1).[A1:Z20000].Copy ThisWorkbook.Sheets("Result").Cells(Rows.Count, 1).End(xlUp)
   .Close 0
  End With
Next
End Sub
謝謝

Ian

TOP

adrian_9832

中學生 Rank: 2

帖子: 79
主題: 19
精華: 0
積分: 148
點名: 0
作業系統: WINDOW7
軟體版本: EXCEL 2003
閱讀權限: 20
性別: 男
註冊時間: 2017-5-21
最後登錄: 2023-3-13

3^#

發表於 2019-12-25 00:02 | 只看該作者

本帖最後由 adrian_9832 於 2019-12-25 00:06 編輯

貼到不同的sheet 是指part 2一旦讀取後
sheet1 /sheet2/sheet3/sheet4/ sheet 5/sheet6/....
都同時出現讀取了的資料？

TOP

iverson105

小學生 Rank: 1

帖子: 27
主題: 11
精華: 0
積分: 38
點名: 0
作業系統: window
軟體版本: window7
閱讀權限: 10
性別: 男
註冊時間: 2019-12-12
最後登錄: 2021-4-21

4^#

發表於 2020-1-3 15:17 | 只看該作者

Hello已經改寫出來了
１．可先選取路徑
２．將選取的檔案內容自動往下一個ｓｈｅｅｔ（ｓｈｅｅｔ是自動產生）貼上

  Sub DATA_INPUT()

Sheets("工作表1").Activate
fds = Application.GetOpenFilename("Excel Files (*.xlsm;*.xlsx), *.xlsm;*.xlsx", , , , True)
If IsArray(fds) Then
For i = 1 To UBound(fds)
[A1].Offset(i - 1) = fds(i)
Next
End If

Sheets("工作表1").Activate

For Each A In Range([A1], Cells(Rows.Count, 1).End(xlUp))
With Workbooks.Open(A)
Sheets.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
.Close 0
  End With
  Next

End Sub

Ian

TOP