マクロを使用して給与支払一覧をコピーする方法
- マクロを使用して給与支払一覧をコピーする方法を教えてください。
- コピー元のセルには文字や計算式、他のセルから参照されるものがありますが、エラーが表示されてしまいます。
- コピー元の表示されている文字だけを張り付けることはできるのでしょうか。
- ベストアンサー
マクロの質問です。下記の式があるのですが、コピーしたい、セルには、文字
マクロの質問です。下記の式があるのですが、コピーしたい、セルには、文字や計算式、又は他のセルから参照させてる物もあるので、張り付けたものに、エラーが数多く表示されるのですが、 コピー元の表示されてる文字を 張り付けることは、できるのでしょうか、 よろしくお願いします。 Sub 給与支払一覧() Application.ScreenUpdating = False Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "給与支払一覧" And Sh.Name Like "Sheet*" Then With Worksheets("給与支払一覧") If Sh.Range("I14").Value > 0 Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) Sh.Range("O2:X14").Copy .Cells(1) .Resize(6, 10).Value = Sh.Range("O2:X14").Value End With End If End With End If Next Sh Set Sh = Nothing End Sub
- YOMOGI（@07535373）
- お礼率61% (60/98)
- オフィス系ソフト
- 回答数1
- ありがとう数2
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
Sh.Range("O2:X14").Copy .Cells(1) .Resize(6, 10).Value = Sh.Range("O2:X14").Value 下の行で値が代入されます。 この行があれば上の行は不要ではないでしょうか。 それから 左辺と右辺の行数が一致していませんが何か意図があるのですか？ 一般的には同じはずだと思うのですが、 .Resize(13, 10).Value = Sh.Range("O2:X14").Value
関連するQ&A
- マクロで質問します。
初心者です。 下記のようなマクロの式があるのですが、条件を一つ増やしたいのですが、 イロイロ試してみたのですが、うまくゆきませんので教えてください！ Sub 給与支払一覧() Application.ScreenUpdating = False Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "給与支払一覧" And Sh.Name Like "Sheet*" Then With Worksheets("給与支払一覧") If Sh.Range("D14").Value > 0 Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) Sh.Range("O2:X14").Copy .Cells(1) .Resize(13, 10).Value = Sh.Range("O2:X14").Value End With End If End With End If Next Sh Set Sh = Nothing End Sub この中で If Sh.Range("D14").Value > 0 Then とありますが、 同じ条件で I14も ０より大きいな時としたいのですが、 うまくゆきませんでした。 たぶん基本できな簡単な事と思いますが 分かりません。 If Sh.Range("D14").Value > 0 Then If Sh.Range("I14").Value > 0 Then 並べてみたり If Sh.Range("D14、I14").Value > 0 Then こんなのや If Sh.Range("D14、I14").).Value > 0 Then このような事も 他にも笑われるようなことも・・・・・ よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- マクロの式について教えてください！
マクロの式について教えてください！ 他で使っていたマクロを書き換えて流用してますが、 エラーなどの表示は、出ないのですが、動きません。 考えられる問題を 教えてください。 おねがいします。 下のような式をつかってます。 Sub 給与支払一覧() Application.ScreenUpdating = False Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "給与支払一覧" And Sh.Name Like "Sheet*" Then With Worksheets("給与支払一覧") If Sh.Range("H5").Value > 0 Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) Sh.Range("L1:T5").Copy .Cells(1) .Resize(5, 9).Value = Sh.Range("L1:T5").Value End With End If End With End If Next Sh Set Sh = Nothing End Sub おねがいします。
- ベストアンサー
- オフィス系ソフト
- マクロに手を加えたいのですが・・・・・
マクロに手を加えたいのですが・・・・・ 下記のマクロの式があるのですが、全シートの ＡＫ８にデーターが０以上だったら 指定の範囲のデーター週払い一覧にコピーしなさいと、 書いてあるのだと おもうのですが・・・ （素人なので、分かりませんが） これだと １件だけ要らないデーターを読みこんでしまいます。 色んなシート名が有りますが、 欲しいデータのあるシート名は、 必ずSheet番号となっているので、 Sheet１～Sheet５０までのデーターから （シートNOは、増えたりします） Sheetの名前から 始まる等の指定をしたいのですが、 どのように 書き換えればよろしいでしょうか、 Sub test() Application.ScreenUpdating = False Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "週払一覧" Then With Worksheets("週払一覧") If Sh.Range("AJ８").Value > 0 Then With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) Sh.Range("AB3:AK8").Copy .Cells(1) .Resize(6, 10).Value = Sh.Range("AB3:AK8").Value End With End If End With End If Next Sh Set Sh = Nothing End Sub 私の勘ですが(笑) If Sh.Range("AJ８").Value > 0 Thenの IF Sｈを If ｓｈ"" とか Sh（" "） とか Sh（i）とか＠とか やりましたが 、できませんでした、 初歩的な事でしょうが、 教えてください お願いします。
- ベストアンサー
- オフィス系ソフト
- マクロ 別シートへコピー
いつも回答して頂きありがとうございます。 Worksheets("一覧").Paste Range("C3")と記述したら、エラーもかからずうまく貼り付け出来るが、 Worksheets("一覧").Paste Range(Cells(d,3))と記述したらエラーが発生してしまします。どうしたら上手くいくでしょうか？ 下記に作成中のマクロを記載しておきます。 御指導の方よろしくお願いいたします。 Sub シートを繰り返し選択する(2)() Dim d As Integer Dim cVx As Integer d = 3 cVx = Range("IV7").End(xlToLeft).Column Worksheets(Worksheets("一覧").Cells(d, 2).Value).Range("C7:X7").Copy Worksheets("一覧").Paste Range(Cells(d, 3)) End Sub
- ベストアンサー
- オフィス系ソフト
- 上のセルのコピーのマクロについて
下記コードで、B列（数値）の空白のセルにその上の値をコピーしているんですが、C列（日付）で行ったところ、できませんでした。 Integerが違うと思って変えたんですが、ほかにも関連して変えるところがありますか？？ 宜しくお願いいたします。 Sub 上のセルコピー() Dim i As Integer For i = 1 To Range("B" & Rows.Count).End(xlUp).Row If Cells(i, 2).Value = "" Then Cells(i, 2).Value = Cells(i - 1, 2).Value End If Next i End Sub
- ベストアンサー
- Visual Basic
- マクロをマクロを使ってコピーしたい
Ｅｘｃｅｌ2010です。 今、book1の各シート(ここでは"S1"で特定していますが、たとえばs1、s2、s3の3つがあるとします。)の左上隅「X」マークを右クリックすると出てくる「コードの表示」に以下の内容を記録しています。 ------------- Private Sub Workbook_SheetActivate(ByVal Sh As Object) If Sh.Name = "s1" Then Exit Sub Worksheets("s1").Range("e6") = Sh.Range("an7") Worksheets("s1").Range("e9") = Sh.Range("bj7") Worksheets("s1").Range("e10") = Sh.Range("br7") End Sub ------------- これをbook1のマクロ本体の実行によってbook1のシート"s1"を含むいくつかのシートのあるコピーbook2に、同じようにマクロでこの「Private Sub」をコピーしたいと思っています。どのようのすればいいでしょうか。 よろしくお願いします。
- 締切済み
- その他MS Office製品
- 下記マクロの意味を教えてください。
Sub 済() With Worksheets("管理表") If .AutoFilterMode Then .AutoFilterMode = False End If Range("O7:P7").Select Selection.AutoFilter Selection.AutoFilter Field:=1, Criteria1:="=*済*", Operator:=xlAnd ActiveWindow.SmallScroll Down:=-12 Range("A1").Select End With End Sub よろしくお願い致します。
- 締切済み
- その他（プログラミング・開発）
- ファイルオープン時のマクロが一部実行されない
いつも回答して頂き、ありがとうございます。感謝感謝です。 ファイルオープン時にApplication.Runで３つのマクロを実行させているのですが、最後のマクロだけ実行されません。どうしてでしょうか？もしかして、前の２つで『一覧シート』を除外するマクロを実行しているからでしょうか？御指導の程宜しくお願いいたします。 1番目に実行するマクロ Sub 特定のシート以外の最終履歴と次回予定日を算出する() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Integer c = 3 Do While ws.Cells(2, c).Value <> "" With ws.Cells(6, c) .FormulaR1C1 = "=MAX(R8C:R10000C)" If .Value = 0 Then .Value = "履歴無し" ws.Cells(7, c).ClearContents Else .Value = .Value ws.Cells(7, c) = DateAdd("d", ws.Cells(5, c), DateAdd("m", ws.Cells(4, c), DateAdd("yyyy", ws.Cells(3, c), ws.Cells(6, c)))) End If End With c = c + 1 Loop End If End If Next End Sub ２番目に実行するマクロ Sub 期限の未達と到達を色で分ける() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Long Dim res As Variant For c = 3 To ws.Cells(7, Columns.Count).End(xlToLeft).Column If IsDate(ws.Cells(7, c)) Then If ws.Cells(7, c) > Date Then res = 8 Else res = 3 End If Else res = xlNone End If ws.Cells(7, c).Interior.ColorIndex = res Next c End If End If Next End Sub ３番目に実行するマクロ Sub 各シートの情報を一覧へ転記する() Dim d As Integer Dim retu As Integer d = 3 Do While Cells(d, 2).Value <> "" With Worksheets(Worksheets("一覧").Cells(d, 2).Value) .Activate retu = .Range("IV7").End(xlToLeft).Column .Range(Cells(7, 3), Cells(7, retu)).Copy End With With Worksheets("一覧") .Activate Cells(d, 3).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End With d = d + 1 Loop End Sub
- ベストアンサー
- オフィス系ソフト
- マクロ セル参照時の記述
いつも回答ありがとうございます。 似たような質問をしていますが、下記の記述の(b3.value!"$B$1").の箇所でエラーがかかりました。 .SetSourceData Source:=Range(b3.value!"$B$1").CurrentRegion どのように変更したら上手く動作するのでしょうか？ｂ３は変数です。御指導の程宜しくお願い致します。 Sub グラフの作成() Dim Date1 As Date 'グラフの始点の日付 Dim Date2 As Date 'グラフの終点の日付 Dim SName As String '商品名 Dim b1 As Variant 'グラフの始点のセル番号 Dim b2 As Variant 'グラフの終点のセル番号 Dim b3 As Variant '対象の商品名のセル番号 Dim d1 As Variant 'b1と違う列のセル番号 Dim d2 As Variant 'b2と違う列のセル番号 Dim d3 As Variant 'b3と違う列のセル番号 With Worksheets("集計用") s1: Date1 = Application.InputBox("最初の日付を2012/12/1のように入力してください。") If Date1 = 0 Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b1 = .Columns("B").Find(Date1, , xlValues, 1) If b1 Is Nothing Then If MsgBox("入力した日付が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s1 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d1 = b1.Row s2: Date2 = Application.InputBox("最初の日付を2012/12/31のように入力してください。") If Date1 = 0 Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b2 = .Columns("B").Find(Date2, , xlValues, 1) If b2 Is Nothing Then If MsgBox("入力した日付が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s2 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d2 = b2.Row s3: SName = Application.InputBox("商品名を入力して下さい。") If SName = "False" Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b3 = .Rows("3").Find(SName, , xlValues, 1) If b3 Is Nothing Then If MsgBox("入力した商品名が見当たりません。" & vbNewLine & _ "再度入力しますか？", vbYesNo) = vbYes Then GoTo s3 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d3 = b3.Column Worksheets.Add After:=Worksheets("集計用") ActiveSheet.Name = b3.Value .Activate .Range(b1, b2).Copy _ Destination:=Worksheets(b3.Value).Range("B2") .Activate .Range(Cells(d1, d3), Cells(d2, d3)).Copy _ Destination:=Worksheets(b3.Value).Range("C2") With Worksheets(b3.Value).Range("D2:D" & Range("C65536").End(xlUp).Row) .Formula = "=SUM(C2,D1)" .Value = .Value End With End With Charts.Add With ActiveChart .ChartType = xlColumnClustered .SetSourceData Source:=Range(b3.value!$B$1").CurrentRegion With .Axes(xlValue) .MaximumScale = 10 .MajorUnit = 1 End With .Location Where:=xlLocationAsObject, Name:=b3.Value End With End Sub
- ベストアンサー
- オフィス系ソフト
- セルのコピーで「オブジェクトが必要です。」
次のような処理を考えています。 A B （シート１） 2001/5/1 10000 2001/5/2 3000 ： ： このデータはACCESSからインポートしたものですが、これを下記のような シートに展開しようとしています。 1月 2月 ・・・ （シート２） 1日 10000 ??? 2日 3000 ??? ： ： ： 年が変わるとシートを追加します。 次のようなロジックを考えました。 Dim Rng As Range （他略） I = 2 Wrk_Year = 9999 Worksheets("シート１").Activate Do While (ActiveSheet.Range("A" & I) <> "") Set Rng = Range("A" & I) If Wrk_Year = Year(Rng.Value) Then Else Wrk_Year = Year(Rng.Value) For Each Worksheet In Worksheets '同じシート名があるか If Worksheet.Name = Wrk_Year & "年" Then Sh_Flg = 0 Exit For Else Sh_Flg = 1 End If Next If Sh_Flg = 1 Then Worksheets("シート２").Copy after:=Worksheets(Worksheets.Count) '最後尾にシートコピー ActiveSheet.Name = Wrk_Year & "年" Worksheets("シート１").Activate Sh_Flg = 0 End If End If Cell_Month = Month(Rng.Value) + 1 Cell_Day = Day(Rng.Value) + 1 (1) Rng.Value.Copy Worksheets(Wrk_Year & "年").Cells(Cell_Day, Cell_Month) I = I + 1 Loop ここで、(1)でいつも「オブジェクトが必要です。」とのエラーになってしまいます。 たぶん、非常に基礎的なことだと思うのですが、なぜでしょうか？
- ベストアンサー
- Visual Basic
お礼
ありがとうございます。 なんとなく意味がつかめました。 言われるとうり行数を変更したら、 表示されました。 ありがとうございます。
補足
回答ありがとうございます。 言われた。とうり Sh.Range("O2:X14").Copy .Cells(1) を外したのですが、 どうもセルの枠などが表示しなくなるので、 そのためでしょうか？ 私にもわかりません、 それと左辺と右辺の行数のことですが、 私のは意味がわからないので、 よろしければ 教えてください。 それと 表示されてる文字をそのままコピーして貼り付ける 事は、 可能でしょうか、