Vba copy rows and columns

Seb123

New Member
Joined
Oct 12, 2020
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
Hi, I'm looking for some solution... that help me to copy each row with specific columns 1,5,10 from other sheets to one main based on criteria.
For example from Sheets: Data 1, Data 2 paste all rows one by one to Sheet: Stats starting in cell B10. Criteria if value in Sheets: Data1,Data 2 colum2 = "Home".

I far manage whole row solution.

VBA Code:
Sub Stat()

Dim Lastrow As String
Dim lastRowRpt As String
Dim job As String
Dim i As Integer

Set tws = ThisWorkbook.Sheets("Stats")
tws.Range("B9") = "STATS:"
job = "Home"

Lastrow = Worksheets("Data1").Range("B" & Rows.Count).End(xlUp).Row
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row

For i = 3 To Lastrow
If Worksheets("Data1").Range("B" & i).Value = job And  Then
Worksheets("Data1").Rows(i).Copy
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row
tws.Range("A" & lastRowRpt + 1).Select
tws.Paste
End If
Next i


Dim lastRow2 As String
lastRow2 = Worksheets("Data2").Range("B" & Rows.Count).End(xlUp).Row
For i = 3 To lastRow2
If Worksheets("Data2").Range("B" & i).Value = job And Then
Worksheets("Data2").Rows(i).Copy
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row
tws.Range("A" & lastRowRpt + 1).Select
tws.Paste

End If
Next i
/CODE]
 

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,287
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to MrExcel.
How about
VBA Code:
With Worksheets("Data1")
   For i = 3 To lastrow
      If .Range("B" & i).Value = job Then
         Intersect(.Rows(i), .Range("A:A,E:E,J:J")).Copy
         lastRowRpt = tws.Range("B" & Rows.Count).End(xlUp).Row
         tws.Range("B" & lastRowRpt + 1).PasteSpecial
      End If
   Next i
End With
 

Seb123

New Member
Joined
Oct 12, 2020
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
Works perrfect! Any addional sugestion how can I add header to each finded row and any error check ex. if value not find then instead of copy row will add ="NO DATA" ?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,287
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Do you really want the header row to be repeated every other row?
 

Seb123

New Member
Joined
Oct 12, 2020
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
To be honest I still thinking about best solution... I can define rows and paste the values under ita but still need to have any marking as those rows will be with the same values thru many sheets. So maybe you right but in that case i need to figure out marking ex . data1, data2 in column for each added in B as example abow, and still need to have error control with that ="NO DATA". Some of the sheets will. have NO DATA in A1 so we can take that comment from there.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,287
Office Version
  1. 365
Platform
  1. Windows
Ok, how about
VBA Code:
With Worksheets("Data1")
   If .Range("A1").Value = "" Then tws.Range("B" & Rows.Count).End(xlUp).Offset(1).Value = "No Data"
   For i = 3 To lastrow
      If .Range("B" & i).Value = job Then
         Intersect(.Rows(i), .Range("A:A,E:E,J:J")).Copy
         LastRowRpt = tws.Range("B" & Rows.Count).End(xlUp).Row
         tws.Range("B" & LastRowRpt + 1).PasteSpecial
         tws.Range("E" & LastRowRpt + 1).Value = .Name
      End If
   Next i
End With
 

Watch MrExcel Video

Forum statistics

Threads
1,114,314
Messages
5,547,170
Members
410,775
Latest member
alal1030
Top