Hello,
I am new to VBA and can manage basics like change path and file names. I have attached 2 workbooks and a code below.
What code does is:
1. Make copy of AUDIOGRAMS.xlsx and number it 1.xlsx.
2. Copy data from AUDIOGRAM.xlsm and paste it to 1.xlsx to generate a chart.
3. Save workbook --> Close workbook.
4. Create 2.xlsx for next row in audiogram.xlsm.
So each row in audiogram.xlsm is used to generate charts for individual patients.
PLEASE NOTE: The code below won't work for the attached sheets. This code works with other sheet which is used to generate other workbooks for blood reports. But the concept is same.
I need to copy 43 values in a row ( Ref By EMP NO NAME DEPT. AGE *** DATE LEFT EARFT AIR 250 LEFT EARFT AIR 500 LEFT EARFT AIR 1K LEFT EARFT AIR 1.5K LEFT EARFT AIR 2K LEFT EARFT AIR 3K LEFT EARFT AIR 4K LEFT EARFT AIR 6K LEFT EARFT AIR 8K LEFT EARFT BONE 250 LEFT EARFT BONE 500 LEFT EARFT BONE 1K LEFT EARFT BONE 1.5K LEFT EARFT BONE 2K LEFT EARFT BONE 3K LEFT EARFT BONE 4K LEFT EARFT BONE 6K REMARKS LEFT EAR RIGHT AIR 250 RIGHT AIR 500 RIGHT AIR 1K RIGHT AIR 1.5K RIGHT AIR 2K RIGHT AIR 3K RIGHT AIR 4K RIGHT AIR 6K RIGHT AIR 8K RIGHT BONE 250 RIGHT BONE 500 RIGHT BONE 1K RIGHT BONE 1.5K RIGHT BONE 2K RIGHT BONE 3K RIGHT BONE 4K RIGHT BONE 6K REMARKS RIGHT EAR )
and paste it to sample woorkbook's copy created. (1.xlsx) For eg. I2 to Q2 in sample data file to M6 to M14 in sample file. Similarly for name, age , date , remarks etc. B2 in data file to AR2 in data file (43 entries) need to be copied to sample file to create charts.
I don't understand how the reference cells are set in code below.
These lines decide where to paste data i guess.
wsCard.Cells(6, 3).Offset((card - 1) * 9) = wsSource.Cells(i, j).Offset(, 1)
wsCard.Cells(7, 3).Offset((card - 1) * 9) = wsSource.Cells(i, j).Offset(, 2)
wsCard.Cells(6, 7).Offset((card - 1) * 9) = wsSource.Cells(i, j).Offset(, 3)
wsCard.Cells(7, 7).Offset((card - 1) * 9) = wsSource.Cells(i, j).Offset(, 4)
wsCard.Cells(8, 4).Offset((card - 1) * 9) = wsSource.Cells(i, j).Offset(, 5)
wsCard.Cells(9, 3).Offset((card - 1) * 9) = wsSource.Cells(i, j).Offset(, 6)
Thank you.
If code is misleading, please avoid the code. Simply put -
I want to copy 43 entries in a row to sample blank file, save file and create new file If there are 100 rows, 100 new workbooks will be created in the folder named 1.xlsx, 2.xlsx, 3.xlsx and so on. Only first column Sr No is not copied. Rest 43 need to get copied to their corresponding places.
Code:
Sub altfel()
Dim path As String, card As Integer
Dim wbCard As Workbook, wsCard As Worksheet
Dim wbSource As Workbook, wsSource As Worksheet
Dim lr As Long, i As Long, j As Long
Set wbSource = Workbooks("BLOODGROUPCARDENT.xlsm")
Set wsSource = wbSource.Worksheets("SOURCE DATA")
path = "D:\excelreport\BLOODGROUPCARDENT\"
Set wbCard = Workbooks.Open(Filename:=path & "BLOODGROUPCARDENT.xlsx")
Set wsCard = wbCard.Worksheets("BGCARDS")
With wsSource
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For i = 2 To lr
For j = 1 To 28 Step 7
card = card + 1
wsCard.Cells(6, 3).Offset((card - 1) * 9) = wsSource.Cells(i, j).Offset(, 1)
wsCard.Cells(7, 3).Offset((card - 1) * 9) = wsSource.Cells(i, j).Offset(, 2)
wsCard.Cells(6, 7).Offset((card - 1) * 9) = wsSource.Cells(i, j).Offset(, 3)
wsCard.Cells(7, 7).Offset((card - 1) * 9) = wsSource.Cells(i, j).Offset(, 4)
wsCard.Cells(8, 4).Offset((card - 1) * 9) = wsSource.Cells(i, j).Offset(, 5)
wsCard.Cells(9, 3).Offset((card - 1) * 9) = wsSource.Cells(i, j).Offset(, 6)
Next j
wbCard.SaveCopyAs Filename:=path & i - 1 & ".xlsx"
card = 0
Next i
MsgBox "Check the folder!"
Set wbSource = Nothing
Set wsSource = Nothing
Set wbCard = Nothing
Set wsCard = Nothing
End Sub