How to copy and paste the next row VBA Help.

[punnipah]

Hi,


I want to Copy Rows as highlighted in red, each time the rows will be different. And then Save a new workbook .

-copy and paste the next row
-Rows 16,34,52 only


Ex.Output
highlighted in Yellow

Test.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI
1
2		Detail Debt Information
3	DMSMA004		Date: 08/03/2023
4			Time: 15:21:58
5
6
7	Cust Acc Num :
8	SA Num :
9	Billing Acc Num :	xxxx
10	Mobile Num :
11	Invoice Num :
12	Cust / Tax ID :	xxxx
13	Company Code :
14
15	Com.	Company Type	Tax ID	Cate	Sub Cate	Collec. Segment	CA	CA Name	CIS Type	SA	SA Status	BA	BA Name	Account Name	BA Status	Mobile Num	Mobile Status	Mobile Status Date	Count Mobile	Start Date	End Date	Invoice Num	Month	Due date	Debt Age	Invoice Amount	Current Before VAT	VAT	Good & Service	Total Amount
16	AWN	FBB	xxxx	R	xxxx	GOOD15	xxxx	xxxx				xxxx	xxxx	xxxx	Active	xxxx	Suspend - Credit Limit	xxxx	1	xxxx	23/09/2022	xxxx	6509	xxxx	135	1175.93	1099	76.93	0	1175.93
17													รวม						1							7055.58	6594	461.58	0	7055.58
18													รวม AWN						1							7055.58	6594	461.58	0	7055.58
19											รวม All Company	1							1							7055.58	6594	461.58	0	7055.58
20		Detail Debt Information
21	DMSMA004		Date: 08/03/2023
22			Time: 15:22:41
23
24
25	Cust Acc Num :
26	SA Num :
27	Billing Acc Num :	xxxx
28	Mobile Num :
29	Invoice Num :
30	Cust / Tax ID :	xxxx
31	Company Code :
32
33	Com.	Company Type	Tax ID	Cate	Sub Cate	Collec. Segment	CA	CA Name	CIS Type	SA	SA Status	BA	BA Name	Account Name	BA Status	Mobile Num	Mobile Status	Mobile Status Date	Count Mobile	Start Date	End Date	Invoice Num	Month	Due date	Debt Age	Invoice Amount	Current Before VAT	VAT	Good & Service	Total Amount
34	AWN	AWN	xxxx	R	THA	GOOD15	xxxx	xxxx				xxxx	xxxx	xxxx	Active	xxxx	Active	11/12/2022	1	xxxx	15/10/2022	xxxx	6510	xxxx	121	560.83	0	0	288.2	288.2
35													รวม						1							2313.83	800	56	1185.2	2041.2
36													รวม AWN						1							2313.83	800	56	1185.2	2041.2
37											รวม All Company	1							1							2313.83	800	56	1185.2	2041.2
38		Detail Debt Information
39	DMSMA004		Date: 08/03/2023
40			Time: 15:23:10
41
42
43	Cust Acc Num :
44	SA Num :
45	Billing Acc Num :	xxxx
46	Mobile Num :
47	Invoice Num :
48	Cust / Tax ID :	xxxx
49	Company Code :
50
51	Com.	Company Type	Tax ID	Cate	Sub Cate	Collec. Segment	CA	CA Name	CIS Type	SA	SA Status	BA	BA Name	Account Name	BA Status	Mobile Num	Mobile Status	Mobile Status Date	Count Mobile	Start Date	End Date	Invoice Num	Month	Due date	Debt Age	Invoice Amount	Current Before VAT	VAT	Good & Service	Total Amount
52	AWN	AWN	xxxx	R	THA	HV15	xxxx	xxxx				xxxx	xxxx	xxxx	Active	xxxx	Active	xxxx	1	xxxx	19/11/2022	xxxx	6511	xxxx	86	648	279.44	19.56	349	648
53													รวม						1							2592	1117.76	78.24	1396	2592
54													รวม AWN						1							2592	1117.76	78.24	1396	2592
55											รวม All Company	1							1							2592	1117.76	78.24	1396	2592
56
57
58
59
60	Output
61	Save New Workbook
62	AWN	FBB	xxxx	R	xxxx	GOOD15	xxxx	xxxx				xxxx	xxxx	xxxx	Active	xxxx	Suspend - Credit Limit	xxxx	1	xxxx	23/09/2022	xxxx	6509	xxxx	135	1175.93	1099	76.93	0	1175.93
63	AWN	AWN	xxxx	R	THA	GOOD15	xxxx	xxxx				xxxx	xxxx	xxxx	Active	xxxx	Active	xxxx	1	xxxx	15/10/2022	xxxx	6510	xxxx	121	560.83	0	0	288.2	288.2
64	AWN	AWN	xxxx	R	THA	HV15	xxxx	xxxx				xxxx	xxxx	xxxx	Active	xxxx	Active	xxxx	1	xxxx	19/11/2022	xxxx	6511	xxxx	86	648	279.44	19.56	349	648
65
Sheet1

 

[DanteAmor]

Hi @punnipah : Thanks for posting on the forum.

Consider the following to run the macro:
- Put the macro in the same workbook you have with the data.
- The name of the sheet and according to your example is called "Sheet1"
- The pattern I found is that after the word "Com." on column "A" is the row you want to copy.
- The new book will be saved in the same folder where you have your macro file named "NewBook.xlsx".

So, considering the above, please try the following macro:

Sub copyrows()
  Dim r As Range, f As Range, cell As String
  Dim wb As Workbook
  Dim sh As Worksheet
  
  Set sh = ThisWorkbook.Sheets("Sheet1")
  Set wb = Workbooks.Add
  Set r = sh.Range("A:A")
  Set f = r.Find("Com.", , xlValues, xlWhole, , , True)
  If Not f Is Nothing Then
    cell = f.Address
    Do
      sh.Rows(f.Row + 1).Copy wb.Sheets(1).Range("A" & Rows.Count).End(3)(2)
      Set f = r.FindNext(f)
    Loop While Not f Is Nothing And f.Address <> cell
  End If
  
  wb.SaveAs ThisWorkbook.Path & "\NewBook.xlsx"
End Sub

Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[punnipah]

Hi @punnipah : Thanks for posting on the forum.

Consider the following to run the macro:
- Put the macro in the same workbook you have with the data.
- The name of the sheet and according to your example is called "Sheet1"
- The pattern I found is that after the word "Com." on column "A" is the row you want to copy.
- The new book will be saved in the same folder where you have your macro file named "NewBook.xlsx".

So, considering the above, please try the following macro:

Sub copyrows()
  Dim r As Range, f As Range, cell As String
  Dim wb As Workbook
  Dim sh As Worksheet
 
  Set sh = ThisWorkbook.Sheets("Sheet1")
  Set wb = Workbooks.Add
  Set r = sh.Range("A:A")
  Set f = r.Find("Com.", , xlValues, xlWhole, , , True)
  If Not f Is Nothing Then
    cell = f.Address
    Do
      sh.Rows(f.Row + 1).Copy wb.Sheets(1).Range("A" & Rows.Count).End(3)(2)
      Set f = r.FindNext(f)
    Loop While Not f Is Nothing And f.Address <> cell
  End If
 
  wb.SaveAs ThisWorkbook.Path & "\NewBook.xlsx"
End Sub

Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

Hi @punnipah : Thanks for posting on the forum.

Consider the following to run the macro:
- Put the macro in the same workbook you have with the data.
- The name of the sheet and according to your example is called "Sheet1"
- The pattern I found is that after the word "Com." on column "A" is the row you want to copy.
- The new book will be saved in the same folder where you have your macro file named "NewBook.xlsx".

So, considering the above, please try the following macro:

Sub copyrows()
  Dim r As Range, f As Range, cell As String
  Dim wb As Workbook
  Dim sh As Worksheet
 
  Set sh = ThisWorkbook.Sheets("Sheet1")
  Set wb = Workbooks.Add
  Set r = sh.Range("A:A")
  Set f = r.Find("Com.", , xlValues, xlWhole, , , True)
  If Not f Is Nothing Then
    cell = f.Address
    Do
      sh.Rows(f.Row + 1).Copy wb.Sheets(1).Range("A" & Rows.Count).End(3)(2)
      Set f = r.FindNext(f)
    Loop While Not f Is Nothing And f.Address <> cell
  End If
 
  wb.SaveAs ThisWorkbook.Path & "\NewBook.xlsx"
End Sub

Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

not working

@

 

[punnipah]

Hi @punnipah : Thanks for posting on the forum.

Consider the following to run the macro:
- Put the macro in the same workbook you have with the data.
- The name of the sheet and according to your example is called "Sheet1"
- The pattern I found is that after the word "Com." on column "A" is the row you want to copy.
- The new book will be saved in the same folder where you have your macro file named "NewBook.xlsx".

So, considering the above, please try the following macro:

Sub copyrows()
  Dim r As Range, f As Range, cell As String
  Dim wb As Workbook
  Dim sh As Worksheet
 
  Set sh = ThisWorkbook.Sheets("Sheet1")
  Set wb = Workbooks.Add
  Set r = sh.Range("A:A")
  Set f = r.Find("Com.", , xlValues, xlWhole, , , True)
  If Not f Is Nothing Then
    cell = f.Address
    Do
      sh.Rows(f.Row + 1).Copy wb.Sheets(1).Range("A" & Rows.Count).End(3)(2)
      Set f = r.FindNext(f)
    Loop While Not f Is Nothing And f.Address <> cell
  End If
 
  wb.SaveAs ThisWorkbook.Path & "\NewBook.xlsx"
End Sub

Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

Yes,i see Problem

- Put the macro in the same workbook you have with the data.

My macro not the same workbook what should i do?

 

[punnipah]

Yes,i see 2 Problem


1.My macro not the same workbook what should i do?

2. - The pattern I found is that after the word "Com." on column "A" is the row you want to copy.
some time the the word "Com." on column "A" more than 1 Columns what should i do ?