is it possible copy data invoice information from sheet based on sheet name like this

KalilMe

Active Member
Joined
Mar 5, 2021
Messages
354
Office Version
  1. 2016
Platform
  1. Windows
Hello
I'm not sure if could copy invoice information based on sheet name for this way and I hope so .
I have ENTER sheet should match sheet name based on M14 ,then should copy Invoice INFO(G2:G4) ,A20: G33 but the last row before total could be change , means doesn't row 33 is ending
example :

UP (3).xlsm
ABCDEFGHIJKLM
1[Company Name]INVOICE
2date2023/05/25
3invoiceFRVG-1000
4clientCR-1000
5
6
7
8
9
10
11
12
13
14SALES
15
16
17
18
19itemGOODSTYPEPRQTYunittotal
201ATRAM1GR5522.001,210.00
212ATRAM2PO1433.00462.00
223ATRAM1SO1044.00440.00
23--
24--
25--
26--
27--
28--
29--
30--
31--
32--
33--
34--
35[42]total2,112.00
ENTER
Cell Formulas
RangeFormula
G2G2=TODAY()
F23:F34F23=IF(ISERROR(MATCH(B23,INV!A:A,0)),0,INDEX(INV!#REF!,MATCH(B23,INV!A:A,0)))
G20:G34G20=F20*E20
G35G35=SUM(G20:G34)
Cells with Data Validation
CellAllowCriteria
B20:B34List=INV!$A$2:$A$3
C20:C34List=TYPE
D20:D34List=PR


before
UP (3).xlsm
ABCDEFGHIJ
1itemdatenameinvoiceGOODSTYPEPRQTYunittotal
2
3
4
5
6
7
8
9
SALES

after
UP (3).xlsm
ABCDEFGHIJ
1itemdatenameinvoiceGOODSTYPEPRQTYunittotal
2125/05/2023CR-1000FRVG-1000ATRAM1GR5522.001,210.00
3225/05/2023CR-1000FRVG-1000ATRAM2PO1433.00462.00
4325/05/2023CR-1000FRVG-1000ATRAM1SO1044.00440.00
5TOTAL25/05/2023CR-1000FRVG-10002,112.00
6
7
8
9
SALES


and should repeat the name and date and invoice until TOTAL as in column B:D row and sum in last row in column J or brings from ENTERING sheet in column G for adjacent cell TOTAL word in column F

another operation
UP (3).xlsm
ABCDEFGHIJKLM
1[Company Name]INVOICE
2date2023/05/25
3invoiceFRVG-10001
4clientCR-10001
5
6
7
8
9
10
11
12
13
14SALES
15
16
17
18
19itemGOODSTYPEPRQTYunittotal
201ATRAM1GR1022.00220.00
212ATRAM2PO1033.00330.00
22-
23--
24--
25--
26--
27--
28--
29--
30--
31--
32--
33--
34--
35[42]total550.00
ENTER
Cell Formulas
RangeFormula
G2G2=TODAY()
F23:F34F23=IF(ISERROR(MATCH(B23,INV!A:A,0)),0,INDEX(INV!#REF!,MATCH(B23,INV!A:A,0)))
G20:G34G20=F20*E20
G35G35=SUM(G20:G34)
Cells with Data Validation
CellAllowCriteria
B20:B34List=INV!$A$2:$A$3
C20:C34List=TYPE
D20:D34List=PR



before

UP (3).xlsm
ABCDEFGHIJ
1itemdatenameinvoiceGOODSTYPEPRQTYunittotal
2125/05/2023CR-1000FRVG-1000ATRAM1GR5522.001,210.00
3225/05/2023CR-1000FRVG-1000ATRAM2PO1433.00462.00
4325/05/2023CR-1000FRVG-1000ATRAM1SO1044.00440.00
5TOTAL25/05/2023CR-1000FRVG-10002,112.00
6
7
8
9
SALES
Cells with Data Validation
CellAllowCriteria
E2:E4List=INV!$A$2:$A$3
F2:F4List=TYPE
G2:G4List=PR
E6:E7List=INV!$A$2:$A$3
F6:F7List=TYPE
G6:G7List=PR


aftre
UP (3).xlsm
ABCDEFGHIJ
1itemdatenameinvoiceGOODSTYPEPRQTYunittotal
2125/05/2023CR-1000FRVG-1000ATRAM1GR5522.001,210.00
3225/05/2023CR-1000FRVG-1000ATRAM2PO1433.00462.00
4325/05/2023CR-1000FRVG-1000ATRAM1SO1044.00440.00
5TOTAL25/05/2023CR-1000FRVG-10002,112.00
6125/05/2023CR-1001FRVG-1001ATRAM1GR1022.00220.00
7225/05/2023CR-1001FRVG-1001ATRAM2PO1033.00330.00
8TOTAL25/05/2023CR-1001FRVG-1001550.00
9
SALES
Cells with Data Validation
CellAllowCriteria
E2:E4List=INV!$A$2:$A$3
F2:F4List=TYPE
G2:G4List=PR
E6:E7List=INV!$A$2:$A$3
F6:F7List=TYPE
G6:G7List=PR


thanks in advance
 
Last edited:

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Hi @KalilMe .
Thanks for posting on the forum.​

Try the following macro:
VBA Code:
Sub copy_Enter_Sheet()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim sName As String
  Dim i As Long, ini As Long, lr2 As Long, j As Long, k As Long
  Dim f As Range
  
  Set sh1 = Sheets("Enter")
  
  sName = sh1.Range("M14").Value
  If Evaluate("ISREF('" & sName & "'!A1)") = False Then
    MsgBox "The sheet does not exist: " & sName
    Exit Sub
  End If
  
  Set sh2 = Sheets(sName)
  Set f = sh1.Range("F:F").Find("total", , xlValues, xlWhole, xlByRows, xlPrevious, False)
  If Not f Is Nothing Then
    ReDim a(1 To f.Row, 1 To 10)
    lr2 = sh2.Range("A" & Rows.Count).End(3).Row + 1
    ini = lr2
    
    For i = 20 To f.Row - 1
      If sh1.Range("A" & i).Value = "" Then Exit For
      sh2.Range("A" & lr2).Value = sh1.Range("A" & i).Value
      sh2.Range("B" & lr2).Value = sh1.Range("G2").Value
      sh2.Range("C" & lr2).Value = sh1.Range("G4").Value
      sh2.Range("D" & lr2).Value = sh1.Range("G3").Value
      sh2.Range("E" & lr2).Resize(1, 6).Value = sh1.Range("B" & i).Resize(1, 6).Value
      lr2 = lr2 + 1
    Next
    'Total row
    sh2.Range("A" & lr2).Value = "TOTAL"
    sh2.Range("B" & lr2).Value = sh1.Range("G2").Value
    sh2.Range("C" & lr2).Value = sh1.Range("G4").Value
    sh2.Range("D" & lr2).Value = sh1.Range("G3").Value
    sh2.Range("J" & lr2).Value = sh1.Range("G" & f.Row).Value
    
    'Format cells
    sh2.Range("A" & lr2).Interior.Color = 12946810
    sh2.Range("A" & ini & ":J" & lr2).HorizontalAlignment = xlCenter
    sh2.Range("I" & ini & ":J" & lr2).NumberFormat = "#,##0.00"
    sh2.Range("A" & lr2).HorizontalAlignment = xlLeft
    sh2.Range("J" & lr2).HorizontalAlignment = xlRight
  Else
    MsgBox "There is no word 'total' in column 'F'"
  End If
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​
 
Upvote 0
Excellent !
I forgot mentioned after copy data I want clear data from A2:E(until before TOTAL word ) and clear G3:G4 ,M14 and shouldn't clear any formula in some cells for some columns .
thanks you
 
Upvote 0
clear data from A2:E(until before TOTAL word ) and clear G3:G4 ,M14
Use this:
VBA Code:
Sub copy_Enter_Sheet()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim sName As String
  Dim i As Long, ini As Long, lr2 As Long, j As Long, k As Long
  Dim f As Range
  
  Set sh1 = Sheets("Enter")
  
  sName = sh1.Range("M14").Value
  If sName = "" Then
    MsgBox "Enter sheet name"
    Exit Sub
  End If
  
  If Evaluate("ISREF('" & sName & "'!A1)") = False Then
    MsgBox "The sheet does not exist: " & sName
    Exit Sub
  End If
  
  Set sh2 = Sheets(sName)
  Set f = sh1.Range("F:F").Find("total", , xlValues, xlWhole, xlByRows, xlPrevious, False)
  If Not f Is Nothing Then
    ReDim a(1 To f.Row, 1 To 10)
    lr2 = sh2.Range("A" & Rows.Count).End(3).Row + 1
    ini = lr2
    
    For i = 20 To f.Row - 1
      If sh1.Range("A" & i).Value = "" Then Exit For
      sh2.Range("A" & lr2).Value = sh1.Range("A" & i).Value
      sh2.Range("B" & lr2).Value = sh1.Range("G2").Value
      sh2.Range("C" & lr2).Value = sh1.Range("G4").Value
      sh2.Range("D" & lr2).Value = sh1.Range("G3").Value
      sh2.Range("E" & lr2).Resize(1, 6).Value = sh1.Range("B" & i).Resize(1, 6).Value
      lr2 = lr2 + 1
    Next
    'Total row
    sh2.Range("A" & lr2).Value = "TOTAL"
    sh2.Range("B" & lr2).Value = sh1.Range("G2").Value
    sh2.Range("C" & lr2).Value = sh1.Range("G4").Value
    sh2.Range("D" & lr2).Value = sh1.Range("G3").Value
    sh2.Range("J" & lr2).Value = sh1.Range("G" & f.Row).Value
    
    'Format cells
    sh2.Range("A" & lr2).Interior.Color = 12946810
    sh2.Range("A" & ini & ":J" & lr2).HorizontalAlignment = xlCenter
    sh2.Range("I" & ini & ":J" & lr2).NumberFormat = "#,##0.00"
    sh2.Range("A" & lr2).HorizontalAlignment = xlLeft
    sh2.Range("J" & lr2).HorizontalAlignment = xlRight
    
    'Clear data in Enter sheet
    sh1.Range("A20:E" & f.Row - 1).ClearContents
    sh1.Range("G2:G4,M14").ClearContents
  Else
    MsgBox "There is no word 'total' in column 'F'"
  End If
End Sub

;)
 
Upvote 1
Solution

Forum statistics

Threads
1,223,228
Messages
6,170,875
Members
452,363
Latest member
merico17

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