*別ブックのファイルの値を取り込む
別ブックのデータをアクティブシートの指定したセルに代入
*ハイライトの箇所を変更して活用してください
Sub 別ブックをアクティブシートに転記1()
'このファイル
Dim Wb1 As Workbook
Set Wb1 = ThisWorkbook
Dim ws1 As Worksheet
Set ws1 = Wb1.Worksheets("Sheet1 (2)")
Dim rng1 As Range
Set rng1 = ws1.Range("A2")
'相手ファイル(インポートファイル)
Dim FName As String
FName = "C:\Users\y1ban\OneDrive\デスクトップ\マクロ\社員マスタ.xlsx"
If FName <> "False" Then
Dim Wb2 As Workbook
Set Wb2 = Workbooks.Open(FName)
Dim ws2 As Worksheet
Set ws2 = Wb2.Worksheets(1)
Dim rng2 As Range
Set rng2 = ws2.Range("A1")
Else
GoTo Skip
End If
rng1 = rng2
Skip:
'相手ファイル閉じる
Application.CutCopyMode = False
Wb2.Close savechanges:=False
MsgBox "完了"
End Sub
解説
- シート名を指定 → 7行目:Set ws1 = Wb1.Worksheets(“Sheet1 (2)”)
- セルを指定 → 9行目:Set rng1 = ws1.Range(“A2”)
- パスを指定 → 13行目:FName = “C:\Users~\ファイル名.xlsx”
- シート名を指定 → 19行目:Set ws2 = Wb2.Worksheets(1)
- セルを指定 → 21行目:Set rng2 = ws2.Range(“A1”)
- 値を代入 → 26行目:rng1 = rng2
別ブックのデータをアクティブシートの最終列のセルに値を代入
Sub 別ブックをアクティブシートに転記2()
'このファイル
Dim Wb1 As Workbook
Set Wb1 = ThisWorkbook
Dim ws1 As Worksheet
Set ws1 = Wb1.Worksheets("Sheet1 (2)")
'最終列の列番号を取得(2行目の最終列を取得)
Dim LastCol1 As Long
LastCol1 = ws1.Cells(2, Columns.Count).End(xlToLeft).Column
'相手ファイル(インポートファイル)
Dim FName As String
FName = "C:\Users\y1ban\OneDrive\デスクトップ\マクロ\社員マスタ.xlsx"
If FName <> "False" Then
Dim Wb2 As Workbook
Set Wb2 = Workbooks.Open(FName)
Dim ws2 As Worksheet
Set ws2 = Wb2.Worksheets(1)
'最終列の列番号を取得(2行目の最終列を取得)
Dim LastCol2 As Long
LastCol2 = ws2.Cells(2, Columns.Count).End(xlToLeft).Column
Else
GoTo Skip
End If
'最終列に転記
ws1.Cells(2, LastCol1 + 1).Value = ws2.Cells(2, LastCol2).Value
Skip:
'相手ファイル閉じる
Application.CutCopyMode = False
Wb2.Close savechanges:=False
MsgBox "完了"
End Sub
解説
- シート名を指定→7行目:Set ws1 = Wb1.Worksheets(“Sheet1 (2)”)
- セルを指定→11行目:LastCol1 = ws1.Cells(2, Columns.Count).End(xlToLeft).Column
- パスを指定→15行目:FName = “C:\Users~\ファイル名.xlsx”
- シート名を指定→19行目:Set ws2 = Wb2.Worksheets(1)
- セルを指定→21行目:LastCol2 = ws2.Cells(2, Columns.Count).End(xlToLeft).Column
- 値を代入→32行目:ws1.Cells(2, LastCol1 + 1).Value = ws2.Cells(2, LastCol2).Value
コメント