【エクセルマクロ】に詳しい方教えて下さい。

とりあえず

If DataSheet.Cells(r, 2).Value => 1 Then

PrintSheet.Cells(1, 1).Value = DataSheet.Cells(r, 1).Value

のところはＤ列と、AV1ということで

If DataSheet.Cells(r, 4).Value => 1 Then

PrintSheet.Cells(1, 48).Value = DataSheet.Cells(r, 1).Value

こんなやり方も、あるという事で、みてください。

これは、cellじゃなくRangeで指定する場合です。

(sortとか貼り付けの例としてみてください)

(随分前に作ったものを引っ張り出しているので、まちがいがあるかもしれません)

Sub test()

Dim PrintSheet As Worksheet

Dim DataSheet As Worksheet

Dim r As Long

Set PrintSheet = Worksheets("印刷用シート")

Set DataSheet = Worksheets("データシート")

r = 1

'D列で　sort
  DataSheet.Select
  Range("A1").Select
  Range("a1").Activate
  Selection.End(xlToLeft).Select
  Selection.End(xlUp).Select
  Range(Selection, Selection.End(xlDown)).Select
  Range(Selection, Selection.End(xlToRight)).Select
  Application.CutCopyMode = False
  Selection.sort Key1:=Range("D1"), Order1:=xlAscending, Key2:=Range("AD2" _
    ), Order2:=xlAscending, Key3:=Range("M2"), Order3:=xlAscending, Header _
     :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
    , SortMethod:=xlPinYin
  Range("A1").Select
  Range("a1").Activate

'データ量抽出 参考
'   DataSheet.Select
'   Range("A1").Select
'   Range("a1").Activate
'   Selection.End(xlToLeft).Select
'   Selection.End(xlDown).Select
'　　　　　　　　　　Selection.Rows.Row ←この時の、この値が最終行

' おまじない
  PrintSheet.Select

Do While DataSheet.Range("d" & r ).Value <> ""

If DataSheet.Range("d" & r ).Value >= 1 Then

'データの値のみコピー(セル値=式としてはコピーしません)

DataSheet.Range("a" & r).Copy

PrintSheet.Range("AV1").PasteSpecial Paste:=xlPasteValues, _

Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'一応コメント
' PrintSheet.Calculate

PrintSheet.PrintOut

End If

r = r + 1

Loop

End Sub

'プリンタの選択例

' Application.ActivePrinter = "プリンターです on Ne01:"

'プリンタのセットアップ例

Sub prt_set()

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = "&18&Uヘッダータイトル等"

.RightHeader = "" & Chr(10) & " &P頁"

.LeftFooter = ""

.CenterFooter = ""

.RightFooter = ""

.LeftMargin = Application.InchesToPoints(0.68)

.RightMargin = Application.InchesToPoints(0.43)

.TopMargin = Application.InchesToPoints(1.10236220472441)

.BottomMargin = Application.InchesToPoints(0.62)

.HeaderMargin = Application.InchesToPoints(0.78740157480315)

.FooterMargin = Application.InchesToPoints(0.393700787401575)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintNoComments

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlLandscape

.Draft = False

.PaperSize = xlPaperA4

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = 92

' ↓エラーになるのでコメント

' .PrintErrors = xlPrintErrorsDisplayed

End With

ActiveWindow.SelectedSheets.PrintPreview

End Sub