Copying rows from one table to another [duplicate] - excel

This question already has answers here:
Copy every nth line from one sheet to another
(8 answers)
Closed 7 years ago.
Suppose I have a table in excel containing 1000 rows and 10 columns.
How can I copy every 7th row from this table to a new table whose first row will be this 7th row, second row will be that table 14th row and so on.
I have never done these kind of things in excel before.
How to do it?

If you want to stick with plain Excel (no VBA). Add two columns at the end of your table. The first being a count of the line, the second flagging if the line count is divisible by 7 - I used the formula =IF(MOD(D4,7)=0,"Divisible by 7", "-").
Then filter the table on the 'Mark every 7th item' column, and copy and paste to new table.

You need a macro. Press alt + F11
Basically you run that macro that goes like this
sub Copyer()
dim I as integer
Dim K as integer
I = 7
K = 1
while (Activesheet.Range("A" & I ).Value <> "")
DestinationSheet.Range("A" & K ).Value = Activesheet.Range("A" & I).Value
K = K + 1
I = I + 7
Loop
End Sub
Code may need some grooming but that's the idea

Related

For Loop to Copy Rows on a Separate Tab

I have tried so many ways to make this work and its just not! j is the # of tabs its searching through (TailValue is an arraylist.Tested & works). k is the # of rows its supposed to be searching (Starting on Row 2 ending on Row 12). WantedDate is a text box for the date to search.
What I need it to do: Go through each tab. Find any date that matches the WantedDate (Only search Rows A2:A12). Copy the entire row and either paste it or insert it on the 2nd Row of the Mx EOD Tab
Every time I get it to atleast kind of function it pulls a random rows on each tab and/or it pulls the wrong date and inserts it on the MX EOD Tab twice.
If the "If Statement" needs an "Else" (If the date does not match the wanted date) I need it to move to the next row in the range and compare. There can be multiple rows with this date. Thank you for any and all help!!
For j = 0 To 20 'Or to LastRow (Cant figure out how to get the last row with text)
For k = 2 To 15 'Or to LastRow ("")
If Worksheets(TailValue(j)).Cells(k, 1).Value = WantedDate Then
Worksheets(TailValue(j)).Rows(ActiveCell).EntireRow.Copy
Worksheets("Mx EOD").Activate
Rows(2).Insert
End If
Next k
Next j

How to copy the number if contains certain number (first 4 digit) to another column - EXCEL VBA

I'm trying to search on the specific column(E), and if matched with the first 4 digit, I would like to copy the number to a different column.
Column E is where i would like to paste all the random number(dynamic)
Column A/B/C is static where i would add 4 digits from time to time.
Column I/J/K is where is would like to paste the result.
PS:
I'm doing it manually and would really appreciate if someone can help me out with the automation hence no code is provided. :(
Having ExcelO365 means you may use FILTER(). Therefor try the below:
Formula in I2:
=FILTER($E:$E,ISNUMBER(MATCH(--LEFT($E:$E,4),A:A,0)))
Drag right to K2. Now, this is dynamic and will change accordingly upon data entry in column E:E, or changing values in A:C.
this is the code to execute on sheet 1, it goes through the entire column E and validates through the formula of counting if in each of the first three columns and assigns the value found in the corresponding columns.
Sub macro()
Dim Static_Data As String
Dim Sht As Worksheet
Set Sht = ThisWorkbook.Sheets("Hoja1")
Active_row = 2
Do While Sht.Range("E" & Active_row).Value <> ""
Static_Data = Sht.Range("E" & Active_row).Value
For i = 1 To 3
If Application.WorksheetFunction.CountIf(Sht.Columns(i), Mid(Static_Data, 1, 4)) > 0 Then
Sht.Cells(Sht.Cells(Rows.Count, i + 8).End(xlUp).Row + 1, i + 8).Value = Static_Data
End If
Next i
Active_row = Active_row + 1
Loop
End Sub
For Excel versions that don't support FILTER or as an alternative you can use standard formulas for this.
If you use columns F-H as helper columns (and these columns can be hidden) then the formula in F2 will be:
=IF(NOT(ISERROR(VLOOKUP(VALUE(LEFT($E2,4)),A$2:A$100,1,FALSE)))=TRUE,$E2,"")
The formula can then be copied across and down. This will find your matches.
In order to then remove the blanks from the data you can use the following formula in I2 and again copy across and down. Depending on how many numbers you want to add in, you may want to extend the range A$2:A$100 in the top formula and F$2:F$100 in the bottom formula
=IFERROR(INDEX(F$2:F$100,AGGREGATE(15,6,(ROW(F$2:F$100)-ROW(F$2)+1)/(F$2:F$100<>""),ROWS(I$2:I2))),"")

For Loop delete row, loop is skipping row [duplicate]

This question already has answers here:
VBa conditional delete loop not working
(4 answers)
Closed 4 years ago.
I have the following For Loop. It is supposed to delete lines with all the . 's.
It is deleting the lines, but when there are rows are like the picture, the code is skipping one of them and deleting one of them.
For row_num = 8 To max_row
page_title = Sheets("Stack").Range("C" & row_num + 1).value
If page_title = " ....................................................................................................................................................................................................................................................................................................." Then
Sheets("Stack").Range("C" & row_num + 1).EntireRow.delete
End If
Debug.Print page_title
Next row_num
Can anyone help with deleting sequential rows that contain .'s ?
This is beacuse the logic of the routine. For example, if you delete row 5, now row 6 will be row 5 and so on, so row 6 will not be read. Insted of delete the row, try setting the values of the column as Empty
Sheets("Stack").Range("C" & row_num + 1).EntireRow = Empty
And you will see all lines will be read.
After you finish, you can tell excel/vba to roganize your matriz according to one column, so empty rows will be organized at the end, is that to say, will become part of the rest empty spacies of the sheet

Copy column from one sheet to another using VBA (with loop)

I am trying to copy columns from Sheet 1 and paste them in Sheet 2, particularly in the next empty column on sheet 2 (so that I don't overwrite data). In total, I need to copy columns 3-81.
Here is the code I have so far:
Dim col As Integer
For i = 3 To 81
Worksheets("Sheet1").Columns(i).Copy Destination:=Sheets("Sheet 2").Column(i).
Since I apply a function to every pasted column before copying and pasting the next one, I cannot simply denote the destination as column (i) because it will simply overwrite that last column of calculated data.
How can I change the destination so that I do not have this problem?
This question has been asked many times before however I cannot find my solution since I seem to be the only one using a loop and assigning col as i.
Dim i As Long, j As Long
j = 3
For i = 3 To 81
Worksheets("Sheet1").Columns(i).Copy _
Destination:=Sheets("Sheet 2").Columns(j)
j = j + 2
Next i

Macro to insert line break in excel rows in specific column [duplicate]

This question already has answers here:
Add line breaks in cell to 1000 rows of data
(3 answers)
Closed 6 years ago.
I am naïve to macros and I need a macro button to enter line break at the end of every data in the row. I have around 1000 rows of data in specific columns. I need to apply this to selected columns. I am currently using ALT+ENTER, but it is time consuming.
Any help would be much appreciated.
I am currently using below code
Sub Macro
Dim Stem As Variant
Stem = ThisWorkbook.Worksheets ("Sheet1").Range("C2")
Range ("K2").Select
Range("K2").FormulaR1C1 = Stem & Chr(10) & ""
End Sub
Above code copies only C2 data and paste in K2 and apply formula. But I need all data in column C2:C to be copied and pasted in K2:K.
Thanks
If I understand that correctly, you want to loop through the copied records in column K and add a line break?
In that case you can use this (this will copy all columns starting from 1) and loop through cells in K starting from 2, you can change that if needed:
Sub copyAndNewLine()
'copy column C to K
Columns("C").Copy Destination:=Columns("K")
'loop through all cells in K and add new line
For i = 2 To Cells(Rows.Count, "K").End(xlUp).Row
Cells(i, "K").Value = Cells(i, "K").Value & vbCrLf
Next i
End Sub

Resources