Board logo

標題: [發問] VBA 如何將選取的資料, 貼在不同sheet上 [打印本頁]

作者: iverson105    時間: 2019-12-19 10:55     標題: 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
謝謝
作者: iverson105    時間: 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
謝謝
作者: adrian_9832    時間: 2019-12-25 00:02

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

貼到不同的sheet 是指part 2一旦讀取後
sheet1 /sheet2/sheet3/sheet4/ sheet 5/sheet6/....
都同時出現  讀取了的資料?
作者: iverson105    時間: 2020-1-3 15:17

Hello已經改寫出來了
1.可先選取路徑
2.將選取的檔案內容自動往下一個sheet(sheet是自動產生)貼上

  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




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)