ビジネスに役立つ講座や交流会を開催
社長・個人事業主からサラリーマン・主婦まで、どなたでも
アベノ塾

ホーム  会場案内  お問合せ

〒545-0052
大阪市阿倍野区阿倍野筋3-12-2
あべのクオレ1F
(ナガセキャリアプラザ アベノ校)
TEL 06-6647-5571

別のコンピュータのブックコピーからシートの合体CSV作成

(1)ブックのコピー

全国の営業所のフォルダーの中に経理のデータがあります。

東京・名古屋・福岡のフォルダーが共有されており自分のコンピュータから操作できる設定になっております。
それらのブックを大阪の自分のフォルダーにコピーします。
ブック名は経理東京・経理名古屋・経理福岡とします。
Sub bookcopy()
'NCP1コンピュータの東京フォルダーの経理.xlsxを自分のデータフォルダーにコピーするファイル名は経理東京.xlsx
     FileCopy "\\Ncp1\東京\経理.xlsx", "d:\自分のデータ\経理東京.xlsx"
'Kunren2コンピュータの名古屋フォルダーの経理.xlsxを自分のデータフォルダーにコピーするファイル名は経理東京.xlsx
     FileCopy "\\Kunren2\名古屋\経理.xlsx", "d:\自分のデータ\経理名古屋.xlsx"
'Nagase3コンピュータの福岡フォルダーの経理.xlsxを自分のデータフォルダーにコピーするファイル名は経理福岡.xlsx
     FileCopy "\\Nagase3\福岡\経理.xlsx", "d:\自分のデータ\経理福岡.xlsx"
End Sub

(2)指定月のシートを自分のブックに集める。

全国の営業所の経理データを確認修正後
当月のシートを合体ブックに集める。
Sub 指定月()
    Dim tuki As String
    tuki = InputBox("取り出したい年月")
'取り出したい年月を覚えておく
    Cells(11, 6) = tuki
'経理東京の指定月のシートを取り出して東京年月のシート名に変更する
    Workbooks.Open Filename:="d:\自分のデータ\経理東京.xlsx"
    Workbooks("経理東京.xlsx").Worksheets(tuki).Copy after:=Workbooks("自分.xlsm").Worksheets("メニュー")
    Worksheets(tuki).Name = "東京" & tuki
    Workbooks("経理東京.xlsx").Close
'経理名古屋の指定月のシートを取り出して名古屋年月のシート名に変更する
    Workbooks.Open Filename:="d:\自分のデータ\経理名古屋.xlsx"
    Workbooks("経理名古屋.xlsx").Worksheets(tuki).Copy after:=Workbooks("自分.xlsm").Worksheets("メニュー")
    Worksheets(tuki).Name = "名古屋" & tuki
    Workbooks("経理名古屋.xlsx").Close
'経理福岡の指定月のシートを取り出して福岡年月のシート名に変更する
    Workbooks.Open Filename:="d:\自分のデータ\経理福岡.xlsx"
    Workbooks("経理福岡.xlsx").Worksheets(tuki).Copy after:=Workbooks("自分.xlsm").Worksheets("メニュー")
    Worksheets(tuki).Name = "福岡" & tuki
    Workbooks("経理福岡.xlsx").Close
End Sub

(3)シートの合体


Sub 合体()
    Dim i As Long
    Dim j As Long
    Dim tuki As String
    Dim lastrow As Long
    Dim saigo As Long
    Worksheets("合体").Cells.Clear
'取り出した年月を変数tukに代入
    tuki = Cells(11, 6)
    lastrow = Worksheets("東京" & tuki).Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To lastrow
        For j = 1 To 5
            Worksheets("合体").Cells(i, j) = Worksheets("東京" & tuki).Cells(i, j)
        Next
    Next
    saigo = i
    lastrow = Worksheets("名古屋" & tuki).Cells(Rows.Count, 1).End(xlUp).Row
    For i = 3 To lastrow
        For j = 1 To 5
            Worksheets("合体").Cells(saigo, j) = Worksheets("名古屋" & tuki).Cells(i, j)
        Next
        saigo = saigo + 1
    Next
    lastrow = Worksheets("福岡" & tuki).Cells(Rows.Count, 1).End(xlUp).Row
    For i = 3 To lastrow
        For j = 1 To 5
            Worksheets("合体").Cells(saigo, j) = Worksheets("福岡" & tuki).Cells(i, j)
        Next
        saigo = saigo + 1
    Next
'1列目の書式を月日・1行1列目の書式を年月にする
    Worksheets("合体").Select
    Columns("A:A").Select
    Selection.NumberFormatLocal = "m""月""d""日"";@"
    Range("A1").Select
    Selection.NumberFormatLocal = "yyyy""年""m""月"";@"
End Sub

(4)CSVの出力1

Sub csvoutput()
    Worksheets("合体").Select
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="D:\自分のデータ\ikou.csv", FileFormat:=xlCSV, _
        CreateBackup:=False
    Application.DisplayAlerts = True
End Sub
問題点
csvファイル作成後、ikou.csvが自分ブックと同じ内容の画面がでる。

保存しないにしないとikou.csvが正しく作成できない。

 

日付が表示のままでデータになってしまう。

 

(5)CSVの出力2

項目間が“ではさまれています。
Write文を使っています。

Sub csvoutput1()
    Dim FileNamePath As Variant
    Dim ch1 As Long
    Dim lastrow As Long
    Dim i As Long
    Dim j As Long
    Dim data(4) As String
    FileNamePath = "d:\自分のデータ\ikou.csv"
    Worksheets("合体").Select
    lastrow = Worksheets("合体").Cells(Rows.Count, 1).End(xlUp).Row
    ch1 = FreeFile
    Open FileNamePath For Output As #ch1
    For i = 2 To lastrow
        For j = 1 To 5
            data(j - 1) = Cells(i, j)
        Next
        Write #ch1, data(0), data(1), data(2), data(3), data(4)
    Next
    Close #ch1
End Sub

(6)CSVの出力3

項目間が、だけではさまれています。
Print文を使っています。

Sub csvoutput2()
    Dim FileNamePath As Variant
    Dim ch1 As Long
    Dim lastrow As Long
    Dim i As Long
    Dim j As Long
    Dim data(4) As String
    FileNamePath = "d:\自分のデータ\ikou.csv"
    Worksheets("合体").Select
    lastrow = Worksheets("合体").Cells(Rows.Count, 1).End(xlUp).Row
    ch1 = FreeFile
    Open FileNamePath For Output As #ch1
    For i = 2 To lastrow
        For j = 1 To 5
            data(j - 1) = Cells(i, j)
        Next
        Print #ch1, data(0); ","; data(1); ","; data(2); ","; data(3); ","; data(4)
    Next
    Close #ch1
End Sub