VBA 別ブックへのデータ転記
別ブックへのデータの転記についてご教示お願いいたします。
以下、やりたいことです。
Bookの構成4種類
1.抽出用
（csvデータをコピーして、転記用Bookに移す為の加工をしており、A列に〇がついたものでO列の値（1～3）別にそれぞれのBookへ転記しようと考えています。
2.転記O列1用
3.転記Ｏ列2用
4.転記O列3用
現在のコードは以下の通りで、わからない点は大まかに2点あります。
1点目は、O列の値（1～3）の値を見てBookを開く（現在は指定のBookを開くコードになっています）
2点目は、転記用への転記の方法
例えば、抽出用のA2とA4に〇がついてO列が共に1だとすると、転記O列1用のBookを開いて、
A2のデータを以下のように。
抽出用 転記O列1用
P列の値 → A7へ
C列の値 → A8へ
H列の値 → A9へ
I列の値 → A10へ
F列の値 → E5へ
L列の値 → D6へ
M列の値 → D7へ
K列の値 → F9へ
J列の値 → D8へ
A4のデータを以下のように。
抽出用 転記O列1用
P列の値 → A12へ
C列の値 → A13へ
H列の値 → A14へ
I列の値 → A15へ
F列の値 → E10へ
L列の値 → D11へ
M列の値 → D12へ
K列の値 → F14へ
J列の値 → D13へ
以上のような事がしたいのですが、
現在、勉強中の初心者で…参考書を見ながら以下のコードまでしか出来ませんでした。
このコードもめちゃくちゃなのかもしれないのでお恥ずかしいのですが…
なんとかこのデータを仕上げたいと思っています。
ご教示よろしくお願いいたします。
Sub ボタン2_Click()
Dim myCnc1 As String
Dim myCnc2 As String
Dim myFileName As String
Dim sheet1 As Worksheet
myFileName = "受注.csv"
Set sheet1 = Worksheets(2)
sheet1.Activate
myCnc1 = "TEXT;"
myCnc2 = ThisWorkbook.Path & "\" & myFileName
With ActiveSheet.QueryTables.Add( _
Connection:=myCnc1 & myCnc2, _
Destination:=Range("A1"))
.TextFilePlatform = 932
.TextFileCommaDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.Refresh
End With
Columns("A:A").Insert
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
FieldInfo:=Array(1, 5)
Columns("G:G").Select
Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
FieldInfo:=Array(1, 5)
Columns("O:O").Select
Selection.TextToColumns Destination:=Range("O1"), DataType:=xlDelimited, _
FieldInfo:=Array(1, 5)
Dim r As Long
r = Range("E" & Rows.Count).End(xlUp).Row
Columns("E:E").Insert
Range("E2:E" & r).FormulaR1C1 = "=LEFT(RC[-1],10)"
Range("E2:E" & r).Value = Range("E2:E" & r).Value
Range("D1").Copy Range("E1")
Columns("D:D").Delete
Columns("H:H").NumberFormatLocal = "0_ "
Columns("O:O").Insert
Range("O2:O" & r).FormulaR1C1 = "=Right(RC[-1],3)"
Range("O2:O" & r).Value = Range("O2:O" & r).Value
Range("N1").Copy Range("O1")
Range("O1") = Range("N1") + "2"
Range("A1").Select
Dim myRng1 As Range
Dim myRng2 As Range
Dim mySht As Worksheet
Set myRng1 = _
ActiveSheet.Range("c1").CurrentRegion
With myRng1
.AutoFilter Field:=3, Criteria1:="=J*"
Set myRng2 = .SpecialCells(xlCellTypeVisible)
.AutoFilter
myRng2.EntireRow.Hidden = True
On Error Resume Next
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error GoTo 0
myRng2.EntireRow.Hidden = False
End With
Set myRng1 = Nothing
Set myRng2 = Nothing
myFileName = ThisWorkbook.Path & "\転記O列1用.xlsm"
Workbooks.Open Filename:=myFileName
End Sub
補足
ご回答ありがとうございます。 もうすでに決まったフォームがあるので、こちらのやり方は、また今度使用させていただこうと思います。ありがとうございました。