VBA auto fill in information from the list in one sheet to another sheet and save as the excel file.

ngochien251088

New Member
Joined
Jun 27, 2018
Messages
16
Office Version
  1. 2019
Platform
  1. Windows
Dear all,

I would like to ask your help related to VBA excel as my bellow explaination.
In sheet "Data C" is the lookup sheet.
In sheet " Input" at cell C1, this is the list I made from the sheet Data C, row 1: shipments.
I have to manually choose each shipment by each shipment and save it as a new file with the same name of shipment number.
For example: I choose " SCC 181" then save it as the file as SCCc181, and continue to choose SCC 169 then save the file as SCC 169
Because I have to choose 50 to 100 times to make the shipment documents.
Could you please help me with VBA which can solve my problem?
I am a newbie in learning VBA basic only so I hope anyone to do me a favor to write the code for this Excel file.
I am very grateful for any help!
11 Shipment Document - Input sample file - 2024.xlsx
ABC
1ShipemntSCC 181
2
3SCC-839
4ORDER #11416158
5Order Date06/06/2024
6
7LAST SHIP DATE12/08/2024
8BOOKED ETD
9NAK TENDER Date (Suggested)04/08/2024
10STAPLES ITEM #
11 ST180530.00
12 ST180540.00
131ST18055377.00
142ST18056150.00
153ST180571220.00
16 ST180580.00
174ST18059120.00
18 ST180600.00
19 ST180610.00
205ST18062140.00
216ST180631040.00
22 ST180640.00
23 ST180650.00
24 ST180660.00
257ST18067195.00
268ST18074150.00
27 ST180800.00
28 ST180810.00
29 ST180860.00
30 ST180870.00
31 ST180880.00
32TOTAL PACKS3392.00
33TOTAL KGS8706.44
34(Max=19,958kg)
351INVOICE NO.NV24-US-SBI-SCC 064
362VESSEL ORGEORG MAERSK 412N
373ON OR ABOUT22-Mar-24
384FROM HO CHI MINH (ETD: 22-Mar-24)
395TO91748_DECONSOL (ETA 10-May-24)
406INVOICE date15-Mar-24
417PO NOT240105
428PODLOS ANGELES
439PO DATE27-Feb-24
Input
Cell Formulas
RangeFormula
C11:C33,C9,C7,C3:C5C3=+INDEX(DataC!$B$3:$Q$33,ROW(Input!B3)-2,MATCH(Input!$C$1,DataC!$B$1:$Q$1,0))
A11A11=IF(C11>0,1,"")
A12:A31A12=IF(C12>0,MAX($A$11:A11)+1,"")
C38C38="HO CHI MINH (ETD: "&TEXT(C37,"dd-mmm-yy")&")"
Cells with Data Validation
CellAllowCriteria
C1:C2List=OFFSET(DataC!$B$1,0,0,1,COUNTA(DataC!$1:$1)-1)

11 Shipment Document - Input sample file - 2024.xlsx
ABCDEFGHIJKLMNOPQ
1Shipement NoSCC 169SCC 170SCC 171SCC 172SCC 173SCC 174SCC 175SCC 176SCC 177SCC 178SCC 179SCC 180SCC 181SCC 182SCC 183SCC 184
2
3SCC-472SCC-580SCC-675SCC-683SCC-684SCC-688SCC-692SCC-716SCC-748SCC-805SCC-807SCC-834SCC-839SCC-895SCC-925SCC-937
4ORDER #11416146114161471141614811416149114161501141615111416152114161531141615411416155114161561141615711416158114161591141616011416161
5Order Date06/06/2024########################################################################################################################
6
7LAST SHIP DATE12/08/2024########################################################################################################################
8BOOKED ETD
9NAK TENDER Date (Suggested)04/08/2024###########################################################################
10STAPLES ITEM #
11ST180530000000000000000
12ST180540000000000000000
13ST1805537017920816904703311434343771784451
14ST180562011070900010405050400150200180
15ST1805711700840064010000730990260330122014700440
16ST1805832050201060160003060080200620200
17ST18059003030000100200012050020
18ST1806015030000100000010002200270
19ST1806180015002100401501001026000100
20ST180625001702001504060002101005014016000
21ST180630880257459905547545556558512549010408301454820
22ST18064315552098070002050010004030
23ST180650000000000000000
24ST18066600085045025020250005065
25ST180672709595040007055302070195450170
26ST180745021030302203040805010020150101080
27ST180800000000000000000
28ST180810000000000000000
29ST180860000000000000000
30ST180870000000000000000
31ST180880000000000000000
32TOTAL PACKS29721600165933782539300612880176818295941384339236033196126
33TOTAL KGS4592.7073278.8483556.2698101.455826.923483.9341755.8011809.623154.7593900.7241191.5342658.4048706.4396765.9681061.65414565.95
34(Max=19,958kg)
35INVOICE NO.
36VESSEL OR
37ON OR ABOUT
38FROM
39TO
40INVOICE date
41PO NO
42POD
43PO DATE
DataC
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Are both sheets in the same file?
Where is the exact location of the name “Shipemnt” ?
And will the new file contain only the “Input” sheet?
 
Upvote 0
Are both sheets in the same file?
Where is the exact location of the name “Shipemnt” ?
And will the new file contain only the “Input” sheet?
Yes, the both sheets in the same file.
The location of Shipment in sheet Input is C1, I used the data validation to list all the shipment information from sheet Data C from B1 to Q1
The new file contains the input sheet and others like INV-PL because I have to make shipping documents for each shipment.
I have uploaded my excel file via Drobox:
Please see and let me know if you need any further information.
Thank you very much for your support.
 
Upvote 0
Based on ur data, try
VBA Code:
Sub Macro2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic


Dim S1 As Worksheet, S2 As Worksheet
Set S1 = ThisWorkbook.Sheets("Input")
Set S2 = ThisWorkbook.Sheets("DataC")

If S1.AutoFilterMode Then S1.AutoFilter.ShowAllData
If S2.AutoFilterMode Then S2.AutoFilter.ShowAllData


S2.Range("B1:Q1").Copy 'customize with your data (Q1 is last position)
S1.Range("Z2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True

Dim Nwb, Awb As Workbook
Dim Nsh As Worksheet
Set Awb = ActiveWorkbook


Dim i As Integer


For i = 2 To Application.CountA(S1.Range("Z2:Z100"))


Set Nwb = Workbooks.Add
Set Nsh = Nwb.Sheets(1)

With S1
    .Range("Z" & i).Copy
    .Range("C1").PasteSpecial xlPasteValuesAndNumberFormats
    .Range("A1:E50").Copy
End With

Nsh.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Nsh.UsedRange.EntireColumn.ColumnWidth = 15


Dim data As String
data = "D:\UrData" 'Change with ur document without slice ya

Nwb.SaveAs data & "\" & S1.Range("Z" & i).Value & ".xlsx"
Nwb.Close False
If S1.AutoFilterMode Then S1.AutoFilter.ShowAllData
If S2.AutoFilterMode Then S2.AutoFilter.ShowAllData


Next i

S1.Range("Z1:Z100").ClearContents


MsgBox "Pake Nanya"


End Sub
 
Upvote 0
Solution
Based on ur data, try
VBA Code:
Sub Macro2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic


Dim S1 As Worksheet, S2 As Worksheet
Set S1 = ThisWorkbook.Sheets("Input")
Set S2 = ThisWorkbook.Sheets("DataC")

If S1.AutoFilterMode Then S1.AutoFilter.ShowAllData
If S2.AutoFilterMode Then S2.AutoFilter.ShowAllData


S2.Range("B1:Q1").Copy 'customize with your data (Q1 is last position)
S1.Range("Z2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True

Dim Nwb, Awb As Workbook
Dim Nsh As Worksheet
Set Awb = ActiveWorkbook


Dim i As Integer


For i = 2 To Application.CountA(S1.Range("Z2:Z100"))


Set Nwb = Workbooks.Add
Set Nsh = Nwb.Sheets(1)

With S1
    .Range("Z" & i).Copy
    .Range("C1").PasteSpecial xlPasteValuesAndNumberFormats
    .Range("A1:E50").Copy
End With

Nsh.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Nsh.UsedRange.EntireColumn.ColumnWidth = 15


Dim data As String
data = "D:\UrData" 'Change with ur document without slice ya

Nwb.SaveAs data & "\" & S1.Range("Z" & i).Value & ".xlsx"
Nwb.Close False
If S1.AutoFilterMode Then S1.AutoFilter.ShowAllData
If S2.AutoFilterMode Then S2.AutoFilter.ShowAllData


Next i

S1.Range("Z1:Z100").ClearContents


MsgBox "Pake Nanya"


End Sub
Could you please help me a little more to save the files including 2 other sheets as I mentioned above?
I appreciate your help.
 
Upvote 0
Based on ur data, try
VBA Code:
Sub Macro2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationAutomatic


Dim S1 As Worksheet, S2 As Worksheet
Set S1 = ThisWorkbook.Sheets("Input")
Set S2 = ThisWorkbook.Sheets("DataC")

If S1.AutoFilterMode Then S1.AutoFilter.ShowAllData
If S2.AutoFilterMode Then S2.AutoFilter.ShowAllData


S2.Range("B1:Q1").Copy 'customize with your data (Q1 is last position)
S1.Range("Z2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True

Dim Nwb, Awb As Workbook
Dim Nsh As Worksheet
Set Awb = ActiveWorkbook


Dim i As Integer


For i = 2 To Application.CountA(S1.Range("Z2:Z100"))


Set Nwb = Workbooks.Add
Set Nsh = Nwb.Sheets(1)

With S1
    .Range("Z" & i).Copy
    .Range("C1").PasteSpecial xlPasteValuesAndNumberFormats
    .Range("A1:E50").Copy
End With

Nsh.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Nsh.UsedRange.EntireColumn.ColumnWidth = 15


Dim data As String
data = "D:\UrData" 'Change with ur document without slice ya

Nwb.SaveAs data & "\" & S1.Range("Z" & i).Value & ".xlsx"
Nwb.Close False
If S1.AutoFilterMode Then S1.AutoFilter.ShowAllData
If S2.AutoFilterMode Then S2.AutoFilter.ShowAllData


Next i

S1.Range("Z1:Z100").ClearContents


MsgBox "Pake Nanya"


End Sub
I can make the code by myself. Thank you very much for your time.
 
Upvote 0

Forum statistics

Threads
1,224,878
Messages
6,181,527
Members
453,053
Latest member
DavidKele

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top