| |
外部のExcelデータを
コピー先のExcelに全コピーします。
コピー元の３行目から最終行までコピーします
コピー先は、A列からZ列にある文字の最後より下に
コピー元のデータを張りつけています。
コードを書いたのですが、コピー元の６行目までしかコピーされず
原因がわからない状態です。
教えて頂けないでしょうか。
Sub ボタン1_Click()
Dim wsDest As Worksheet
Dim lastRow As Long
Dim nextRow As Long
Dim i As Long, j As Long
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim filePath As String
Dim sourceLastRow As Long
Dim sourceLastCol As Long
' ファイルダイアログを使用してファイルを選択
With Application.FileDialog(msoFileDialogOpen)
.Title = "Select the Excel file"
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls"
.AllowMultiSelect = False
If .Show = -1 Then
filePath = .SelectedItems(1)
Else
MsgBox "ファイルが選択されていません。"
Exit Sub
End If
End With
' 外部ファイルを開く
Set wbSource = Workbooks.Open(filePath)
' 1番目のシートを設定
Set wsSource = wbSource.Sheets(1) ' 1番目のシートを使用
' 勘定科目シートの存在を確認
On Error Resume Next
Set wsDest = ThisWorkbook.Sheets("勘定科目")
On Error GoTo 0
If wsDest Is Nothing Then
MsgBox "シート '勘定科目' が見つかりません。シート名を確認してください。"
wbSource.Close False
Exit Sub
End If
' 勘定科目シートのE列からZ列までの最終行を確認
lastRow = 0
For j = 5 To 26 ' E列からZ列まで
If wsDest.Cells(wsDest.Rows.Count, j).End(xlUp).Row > lastRow Then
lastRow = wsDest.Cells(wsDest.Rows.Count, j).End(xlUp).Row
End If
Next j
' 次にデータを入力する行を設定
If wsDest.Cells(lastRow, 5).Value <> "" Then
nextRow = lastRow + 1
Else
nextRow = lastRow
End If
' 外部ファイルの最終行と最終列を取得
sourceLastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
sourceLastCol = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
' データをコピー（3行目から最終行まで、A列からZ列まで）
For i = 3 To sourceLastRow
For j = 1 To 26 ' A列からZ列まで
wsDest.Cells(nextRow, j).Value = wsSource.Cells(i, j).Value
Next j
nextRow = nextRow + 1
Next i
' 外部ファイルを閉じる
wbSource.Close False
MsgBox "データのコピーが完了しました。"
End Sub
|
|
GAO
- 24/9/20(金) 9:42 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
≪
