advanced help
per page, with , order by , clip by
Results of 1 - 1 of about 295 for cell filename (0.001 sec.)
cell (1170), filename (1984)
[[20221118224914]]
#score: 11157
@digest: 2839978b650a1ce447393e03f5130616
@id: 92836
@mdate: 2022-11-20T13:00:58Z
@size: 7544
@type: text/plain
#keywords: wblastrow (36904), ¥¥¥¥ (29295), ーwb (27370), rowsdata (23618), moto (21781), spec (19108), ペ. (18620), 複防 (16636), savepath (16356), 元. (14396), 先. (13243), マ以 (12233), abc123 (11394), クコ (6608), ー先 (4802), ー元 (4776), filename (4769), 末尾 (4249), desktop (3938), worksheets (3332), 防止 (3226), sheet1 (2931), コピ (2670), users (2616), ブッ (2492), 規作 (2440), xlsm (2366), ピー (2283), 規ブ (2241), デス (1895), cell (1877), xlsx (1867)
『名前を指定したブックから新規ブックへ値をコピー』(AIMS)
お世話になります。 やりたいこと コピー元.xlsm デスクトップにあるブック コピペ.xlsm この質問のマクロが付いているブック コピー先.xlsx 新規作成されるブック 1 デスクトップ上にあるコピー元.xlsmのsheet1の値をコピー先.xlsxのsheet1へコピーする 2 コピー先.xlsxを保存する ファイル名の末尾に(1)をつけて重複防止する 3 コピーする際QTYのコンマ以下の削除 4 コピーする際SPECの末尾4桁の削除 現状 コピー元.xlsmの名前をコピペ.xlsmのA1へ入力するとコピー先.xlsxを新規作成する 参考にしたHPなど 保存の部分 https://www.excel.studio-kazu.jp/kw/20220927165342.html コピー元.xlsmのsheet1の内容 A B C E F G 1 REF NO CODE DESC SPEC QTY 2 ABC123 1 SCREW ASP1 F4¥¥¥¥ 3.0000 3 ABC123 2 LINE PV5 F4¥¥¥¥ 3.0000 4 ABC123 3 STEP PV3 F4¥¥¥¥ 3.0000 5 ABC123 4 SCREW ASP7 F4¥¥¥¥ 3.0000 コピー先.xlsxのsheet1の内容 A B C E F G 1 REF NO DESC CODE SPEC QTY 2 3 空白のシート この並びでコピーしたい 4 5 コピペ.xlsmの内容 A B C 1 2↑A1にコピー元の名前を入力すること 3マクロ実行ボタン A1にコピー元ブックの名前を入力します A2は注意書きの文章です A3にマクロ実行のボタンがあります Sub コピペ() Dim cell As String Dim LastRow As Long Dim wb As Workbook Dim moto As Workbook cell = Range("A1").Value & ".xlsm" Workbooks.Open Filename:="C:¥Users¥ABC¥Desktop¥" & cell Set wb = Workbooks.Add ここからうまくできません C:¥Users¥ABC¥Desktop¥" & cellでコピー元のブックを開くことはできるのですが、どうやって変数を設定すればよいのでしょうか。 こういうような感じでコピーと保存すると思うのですが....どうでしょうか Dim rowsData As Long '行数カウント用の変数 rowsData = moto.Cells(Rows.Count, 1).End(xlUp).Row k = 1 For i = 1 To rowsData 'REFのコピー wb.Sheet1.Cells(k, 1).Value = moto.Sheet1.Cells(i, 1).Value 'NOのコピー wb.Sheet1.Cells(k, 2).Value = moto.Sheet1.Cells(i, 2).Value 'DESCのコピー wb.Sheet1.Cells(k, 3).Value = moto.Sheet1.Cells(i, 4).Value 'CODEのコピー wb.Sheet1.Cells(k, 4).Value = moto.Sheet1.Cells(i, 3).Value 'SPECのコピー wb.Sheet1.Cells(k, 5).Value = moto.Sheet1.Cells(i, 5).Value 'QTYのコピー wb.Sheet1.Cells(k, 6).Value = moto.Sheet1.Cells(i, 6).Value k = k + 1 Next i Const SavePath = "C:¥Users¥ABC¥Desktop¥TEST¥TEST¥" Dim FileName As String Dim i As Integer FileName = SavePath & "AAA-" & Worksheets("sheet1").Range("A2").Value & ".xlsx" Do While Dir(FileName) <> "" i = i + 1 FileName = SavePath & "AAA-" & Worksheets("sheet1").Range("A2").Value & Format(i, "(0)") & ".xlsx" Loop ThisWorkbook.SaveCopyAs FileName:=FileName end sub < 使用 Excel:Excel2019、使用 OS:Windows10 > ---- 最初の辺りだけです。 >どうやって変数を設定すればよいのでしょうか。 ブックを開いた後なので、 Set moto = Workbooks(cell) でどうでしょうか。 >rowsData = moto.Cells(Rows.Count, 1).End(xlUp).Row 変数 moto はブックなので、 rowsData = moto.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ 上記の様に、シートを指定してからセルを指定しないと、エラーになります。 ※訂正不要な箇所がありましたので削除しました。 (wss) 2022/11/20(日) 07:18:49 ---- ↓のように考えてみてはどうでしょうか? 1. データ元となるブックを開く 2. 出力先となるブックを開く(新規ブックを追加する) 3. 【フィルタオプション】で列を入れ替えながら[1]から[2]のブックへ情報を転記する 4. [1]のブックは用済みなので、保存せずに閉じる 5. [2]のブックの"sheet1"について、2行目から最終行まで順番にみていき F列を右から4文字を除いたものに書き換える(左から2文字を取り出す) G列を小数点以下を切り捨てたものに書き換える 6. [5]を名前を付けて保存する (もこな2) 2022/11/20(日) 11:35:34 ---- wssさん、もこな2さん 返事が遅くなってしまいました。 ありがとうございます。 動くマクロが作れたらここに書き込みます。 (AIMS) 2022/11/20(日) 16:13:45 ---- やりたいこと コピー元.xlsm デスクトップにあるブック コピペ.xlsm この質問のマクロが付いているブック コピー先.xlsx 新規作成されるブック 1 デスクトップ上にあるコピー元.xlsmのsheet1の値をコピー先.xlsxのsheet1へコピーする 2 コピー先.xlsxを保存する ファイル名の末尾に(1)をつけて重複防止する 3 コピーする際QTYのコンマ以下の削除 4 コピーする際SPECの末尾4桁の削除 現状 やりたいこと1 できた やりたいこと2 できた やりたいこと3 以下のマクロを実行するとなぜかコンマ以下が削除されてコピーされる 原因はわからないけどやりたいことはできている やりたいこと4 できた もっと簡単なやり方があると思いますが、私の思いつく方法はこれしかありませんでした つたないマクロなので参考になるかわかりませんが、以下に書き残しておきます。 Sub コピペ() Dim cell As String '元のブックの呼び出し Dim moto As Workbook '元のブック Dim LastRow As Long Dim wb As Workbook '新規ブック Dim wbLastRow As Long '新規ブックの最終行 cell = Range("A1").Value & ".xlsm" Workbooks.Open FileName:="C:¥Users¥ABC¥Desktop¥" & cell Set wb = Workbooks.Add Set moto = Workbooks(cell) '変数 moto はブックなのでシートを指定してからセルを指定すること LastRow = moto.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row '元からコピペ k = 1 For i = 2 To LastRow 'REF wb.Worksheets("Sheet1").Cells(k, 1).Value = moto.Worksheets("Sheet1").Cells(i, 1).Value 'NO wb.Worksheets("Sheet1").Cells(k, 2).Value = moto.Worksheets("Sheet1").Cells(i, 2).Value 'DESC wb.Worksheets("Sheet1").Cells(k, 3).Value = moto.Worksheets("Sheet1").Cells(i, 4).Value 'CODE wb.Worksheets("Sheet1").Cells(k, 4).Value = moto.Worksheets("Sheet1").Cells(i, 3).Value 'SPEC wb.Worksheets("Sheet1").Cells(k, 5).Value = moto.Worksheets("Sheet1").Cells(i, 5).Value 'QTY wb.Worksheets("Sheet1").Cells(k, 6).Value = moto.Worksheets("Sheet1").Cells(i, 6).Value k = k + 1 Next i '新規ブックの最終行 wbLastRow = wb.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 'SPEC末尾の削除 'SPEC末尾の文字列削除の作業列を追加 wb.Worksheets("Sheet1").Range("F2").EntireColumn.Insert '作業列にてSPEC末尾の削除 wb.Worksheets("Sheet1").Range("F2:F" & wbLastRow) = "=LEFT(E2, LEN(E2)-4)" '作業列のデータをコピー wb.Worksheets("Sheet1").Range("E2:E" & wbLastRow).Value = wb.Worksheets("Sheet1").Range("F2:F" & wbLastRow).Value '作業列の削除 wb.Worksheets("Sheet1").Columns(6).Delete '保存 重複防止 'Dim Ref As String 'Ref = wb.Worksheets("Sheet1").Range("A2").Value 'ActiveWorkbook.SaveAs FileName:="C:¥Users¥ABC¥Desktop¥TEST¥" & Ref Const SavePath = "C:¥Users¥ABC¥Desktop¥TEST¥" Dim FileName As String Dim n As Integer FileName = SavePath & wb.Worksheets("sheet1").Range("A2").Value & ".xlsx" Do While Dir(FileName) <> "" n = n + 1 FileName = SavePath & Worksheets("sheet1").Range("A2").Value & Format(n, "(0)") & ".xlsx" Loop ActiveWorkbook.SaveAs FileName:=FileName End Sub wssさん、もこな2さん アドバイスありがとうございました。 やりたいことが全て達成できてすっきりしました。 (AIMS) 2022/11/20(日) 22:00:58 ...
https://www.excel.studio-kazu.jp/wiki/kazuwiki/202211/20221118224914.txt - [detail] - similar
PREV NEXT
Powered by Hyper Estraier 1.4.13, with 97054 documents and 608269 words.

訪問者:カウンタValid HTML 4.01 Transitional