View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
GS[_6_] GS[_6_] is offline
external usenet poster
 
Posts: 1,182
Default Copy data of records to a templatesheet and save this template as pdf file (and then the other records one by one)

Hi Johan,

Am Tue, 28 May 2019 07:25:27 -0700 (PDT) schrieb JS SL:

In the same row as part of the loop there should follow the action;
1) Select the data in Sheet1 in column B of the active row of the loop.
For example the text is 'AAAA'.
2) Go to Sheet3 and select the data of column A/B/C where the data in column
A is the same text as the selected data from Sheet1 column B. You select
then the datacolumns A/B/C where in column A the text is 'AAAA' (filtered on
'AAAA' and selection of the visible parts). Copy this data. 3) Go to Sheet2
and copy the selection to datafield C57. This all is an action before the
printout of the pdf file


then try:

Sub SaveAsPDF()
Dim varCrit As Variant, varData1 As Variant, varData2 As Variant
Dim LRow As Long, LRowSh3 As Long, i As Long
Dim dest1 As Range, dest2 As Range

With Sheets("Sheet1")
LRow = .Cells(.Rows.Count, "A").End(xlUp).Row
varCrit = .Range("A2:C" & LRow)
varData1 = .Range(.Cells(2, "D"), .Cells(LRow, "Z"))
varData2 = .Range(.Cells(2, "BB"), .Cells(LRow, "BD"))
End With

LRowSh3 = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row

With Sheets("Sheet2")
Set dest1 = .Range("D4"): Set dest2 = .Range("D30")
For i = LBound(varCrit) To UBound(varCrit)
If varCrit(i, 1) = "Yes" Then
dest1.Resize(UBound(varData1, 2)) = _
Application.Transpose(Application.Index(varData1, i, 0))
dest2.Resize(UBound(varData2, 2)) = _
Application.Transpose(Application.Index(varData2, i, 0))
Sheets("Sheet3").Range("A1:C" & LRowSh3).AutoFilter field:=1,
Criteria1:=varCrit(i, 2) Sheets("Sheet3").Range("A2:C" &
LRowSh3).Copy .Range("C57") Sheets("Sheet3").AutoFilterMode =
False .ExportAsFixedFormat Type:=xlTypePDF, Filename:=varCrit(i,
3) & _ varCrit(i, 2) & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False,
OpenAfterPublish:=False End If
Next
End With
End Sub


Regards
Claus B.


Nice!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion