I would like to create a excel Macro that allows to me copy an x number of rows of certain column. For Example, I have column K that I have in 10.500 rows. I want to copy 1000 lines each time and also the 500 lines at the end. any help with the coding part ? I looked on so many sites and no success. I don't need to paste the copied number in any other excel sheet. I just need the macro command to copy me 1000 lines every time from the column that I selected.
thank youuuuu very much and much appreciated !
Cheers
Select a column and run the sub procedure from the Macros dialog (Alt+F8). The first 1000 cells will be copied to the clipboard.
Paste the data into another program.
Return to Excel and run the sub procedure again. The next 1000 rows of data will be copied to the clipboard.
When the last group of data has been copied to the clipboard, a message box will notify.
Option Explicit
Sub progressiveCopy()
Dim m As Long
Static i As Long, k As Long
Application.CutCopyMode = False
m = 1000
If k <> ActiveCell.Column Then
k = ActiveCell.Column
i = 0
End If
With Worksheets("sheet1")
m = Application.Min(m, .Cells(.Rows.Count, k).End(xlUp).Row - i)
.Cells(i + 1, k).Resize(m, 1).Copy
i = i + m
If i >= .Cells(.Rows.Count, k).End(xlUp).Row Then
MsgBox "This column is complete. Select another column next time."
End If
End With
End Sub
You may wish to set up a hot-key combination for the sub procedure in the Macros dialog to ease repetitive operations.
This code finds the number of rows in the currently selected column. Checks if the number to be copied is less than the rows left. Selects the range and puts the range in copy mode. After the range is copied you would have to go to they sheet, document, or whatever to paste the data.
I've modified the code to then select down 1000 rows or what ever is left in the column. So you should be able to run the code, paste the data, run the code, paste the data. When you hit the end, a message tells you that you are at the end of the column.
Application.CutCopyMode = False
numRowstoCopy = 1000
varCurrentRow = ActiveCell.Row
varCurrentColumn = ActiveCell.Column
FinalRow = Cells(Rows.Count, varCurrentColumn).End(xlUp).Row
varRowsToEnd = FinalRow - varCurrentRow
If varRowsToEnd < numRowstoCopy Then
Range(Cells(varCurrentRow, varCurrentColumn), Cells(varCurrentRow + varRowsToEnd, varCurrentColumn)).Select
Selection.Copy
MsgBox "Last Rows to Paste Have been copied"
Else
Range(Cells(varCurrentRow, varCurrentColumn), Cells(varCurrentRow + numRowstoCopy - 1, varCurrentColumn)).Select
Selection.Copy
ActiveCell.Offset(numRowstoCopy, 0).Select
End If
Related
My first row of my dataset includes a list of 1's or 0's. I am trying to just hide all rows that contain a zero, then copy the entire sheet to a new sheet. I timed it out and the macro takes around 4 minutes to complete running. Why? Is there a way to re-write this macro to make it quicker? I'm trying to keep this macro universal meaning as long as I have a column with 1's & 0's I can quickly hide large amounts of rows of data, not matter the size. Here is the code...Thank you in advance for any assistance!
Sub RemoveLinesWithZero()
For i = 1 To Selection.Rows.Count
For j = 1 To Selection.Rows.Count
If Left(Selection.Cells(j, 1), 1) = "0" Then
Rows(j + 13).EntireRow.Hidden = True
End If
Next j
Next i
ActiveSheet.Copy After:=Sheets(Sheets.Count)
End Sub
I am a newbie to VBA but got tasked to work with it anyway. So my task is to build a macro that takes data from different sheets and puts it below each other in one result sheet ("Tabelle1" in my example). The input data in each sheet is stored in blocks of two columns, right next to each other - so columns A and B have to import into the result sheet, then C and D and so on. Doing this for one sheet is not a problem:
Sub Makro1()
'
' Makro1 Makro
'
Dim Erste As Long
Dim k As Long
Dim j As Long
k = 1
j = 2
Do
Sheets("Tabelle1").Select
Erste = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
Sheets("Tabelle2").Select
Range(Cells(5, k), Cells(5, j)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Tabelle1").Select
Cells(Erste, 3).Select
ActiveSheet.Paste
k = k + 2
j = j + 2
Loop Until Sheets("Tabelle2").Cells(4, k).Value = ""
End Sub
But I not only have one input sheet ("Tabelle2" in this example) but several (up until sheet20 or so). And all of them are built the exact same way, only with different data in each. What I would need the macro to do is, when reaching the empty cell in the first input sheet ("Tabelle2), go to the next input sheet ("Tabelle3") and continue the import of the data.
It doesn't sound too hard to do at first, but I cannot seem to find a solution. If anyone could help me out, it would be very much appreciated :-)
I know that the macro itself is very badly written and I can get rid of most of the Select. But as long as it works I'm fine.
Instead of using the name of the sheet, use the Index
Example: Sheet(1) and Sheet(2) etc
You can use that number as a variable that you can increment.
Example:
Dim i as Integer
Sheet(i).Select
Note:
It is also better practice to change the code to not rely on .Select as it can cause confusion and problems.
In addition, it would be better to use Worksheet(1) as charts can also be referred to as sheets.
I've been coding VBA for many years but this one is a real head-scratcher.
The task is simple - Copy data from a table from Microsoft Word to Microsoft Excel.
The challenge: Maintain the formatting of the data from Word, which includes bulleted lists and multiple paragraphs. More specifically, I need to include all that formatted text from a cell from the Word table inside a single cell in the corresponding Excel table.
Solutions I've already tried and specifically where I got stuck:
METHOD 01: Select the entire table in Word, select a single cell in Excel, and paste.
Sub Method01_CopyAndPaste()
ActiveDocument.Tables(1).Select
Documents(1).ActiveWindow.Selection.Copy
Cells(1, 1).Select
ActiveSheet.Paste
End Sub
PROBLEM WITH METHOD 01: Excel creates multiple rows and merged cells whenever there are multiple paragraphs in the Word Table.
METHOD 02: Loop through the Word table, and assign all the contents to a Array (variant). Then loop through the Excel table and assign the values from the Array into the table.
Sub Method02_Array()
Dim r As Integer
Dim c As Integer
Dim AryTblData(1 To 10, 1 To 10) As Variant
'Loop through the 10x10 Source table and assign all values to 2 dimensional array
For r = 1 To 10
For c = 1 To 10
AryTblData(r, c) = ActiveDocument.Tables(1).Cell(r + 1, c)
Next c
Next r
'Paste the array values into the activesheet starting at cell(1,1)
For r = 1 To 10
For c = 1 To 10
Cells(r, c) = WorksheetFunction.Clean(AryTblData(r, c))
Next c
Next r
End Sub
PROBLEM WITH METHOD 02: The formatting is not preserved. Specifically, the bullet points do not appear in the Excel table.
METHOD 03: Use Application.Sendkeys to simulate the process of manually going to one cell of the Word table, copying it, going to the corresponding cell in the Excel table, pasting it, pressing {TAB} to go to the next cell, and then repeating this process for the total number of cells in the table.
Sub Method03_Sendkeys()
Dim r As Integer
Dim c As Integer
'Loop through the 3x3 Source table and simulate sending keys to copy and paste, cell by cell
For r = 1 To 3
For c = 1 To 3
'Activate Microsoft Word window
AppActivate ("word"), True
'Select the appropriate cell in the Word table (based on the For Loop)
ActiveDocument.Tables(1).Cell(r, c).Select
'In Word, copy the selection
Application.SendKeys "^c", True
'Activate Microsoft Excel window
'Note: I'm not sure why AppActivate ("excel") does not work, but
'for some reason Application.caption works for me.
AppActivate Application.Caption, True
'Select the appropriate cell in the active Excel worksheet (based on the For Loop)
Cells(r, c).Select
'In Excel, edit cell contents
Application.SendKeys "{F2}", True
'In Excel, Paste
Application.SendKeys "^v", True
'In Excel, Save changes to cell and move 1 cell to the right
Application.SendKeys "{TAB}", True
Next c
Next r
End Sub
PROBLEM WITH METHOD 03: It works with only 1 cell, but as soon as I attempt to get more than one cell copied and pasted over, the result is the same data over and over again across multiple cells.
QUESTION: Is this task even possible to achieve in VBA? I'd love to find a simple and elegant solution, but at this point I would settle for something that WORKS.
Thanks so much for your help!
Following on from my comment, the following might work. I can't test as I don't have your source data
Sub Method02_Array()
Dim r As Integer
Dim c As Intege
For r = 1 To 10
For c = 1 To 10
ActiveDocument.Tables(1).Cell(r + 1, c).Range.Copy
ActiveWorkbook.Sheets(1).Cells(r, c).Range.PasteSpecial operation:=xlPasteSpecialOperationNone, Paste:=xlPasteAll
Next c
Next r
End Sub
For pasting multiple lines from Word or a pdf into a single cell in Excel - click on the cell, press F2, then paste the text. That keeps it all in one cell. However it does not keep the formatting including colors and strikeouts
Edit: I only have 28,000 columns, and you all are correct that they can't all fit in one worksheet. I was testing my code with only a portion of the data and hadn't yet realized that it will not all fit
I have 28,000 columns of data. I am trying to to copy specific columns 5,12,19,26...(ie for i=1:4000, column number = 7*(i-1) + 5). My original thought is below, but the problem is that after each iteration of the loop, the previous column is deselected. So the code below does not copy the intended data.
For i = 1 To 4000
DataSheet.Columns(7 * (i - 1) + 5).Select
Next i
Selection.Copy
ResultsSheet.Paste
I thought about the alternative below (which works, but very slowly), but I was hoping I could write something that executes more quickly (part of the problem is the code selects the destination sheet and pastes each column individually, essentially quadrupling the number of steps as something similar to the first solution).
For i = 1 To nSymbols
DataSheet.Columns(7 * (i - 1) + 5).Copy
ResultsSheet.Select
Columns(i+1).Select
ActiveSheet.Paste
Next i
Any ideas on how to make this code run (faster)?
Use Union and increment your For ... Next by 7 for each increment.
dim c as long, rng as range
with worksheets("sheet1")
set rng = intersect(.columns(5), .usedrange)
for c = 12 to 4000 step 7
set rng = UNION(rng, intersect(.columns(c), .usedrange))
next c
end with
debug.print rng.address(0, 0)
rng.copy destination:=ResultsSheet.cells(2, 1)
I've added Intersect with UsedRange to reduce the full column references. Due to the Union'ed range, this Copy & Paste resjults in a Copy, Paste Special, Values and fORMATS.
Hoping you can help an basic excel user please!
I have a file of around 2000 rows and I need to add a line/break after every third one. Is there a simple way of doing this please?
Your help and advice would be much appreciated.
Thanks
Quick way without VBA
In a empty column add this formula, =IF(MOD(ROW(),3)=0,NA(),"") and copy down
Press F5, Goto .... Special, Formulas Errors (selects every third row)
Insert Rows
step 2 shown below
If you want to try some VBA here is a button click event that will do the insert on every third row. Let me know if you have any questions.
Private Sub CommandButton1_Click()
Dim ws As Excel.Worksheet
Dim lRow As Long
Dim lastRow As Long
'Set the worksheet object to the sheet by name
Set ws = Application.Sheets("Sheet1")
'Set the row to start looping(inserting) rows at
lRow = 4
'Find the last row with a value in column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'Account for the amount of rows that will be inserted.
lastRow = lastRow + (lastRow * 0.33)
'Loop through the worksheet from the start row to the last row
Do While lRow <= lastRow
'Insert a row
ws.Rows(lRow).EntireRow.Insert
'Increment the row to insert at on the next pass of the loop
lRow = lRow + 4
Loop
End Sub
a non vba way is create a new column and insert numbering
1
2
3
4
5
6
......
then for empty row, number as 3,6,9,.... (let say u have 2k records, duplicate it 2k)
then sort by the number column, then remove the column
If your content is the same, or repeating, for each row, you could open the file in any basic text editor and do the following:
Highlight and copy the first three rows (including the third line break).
Using find-and-replace (Opt-Cmd-F in TextEdit on Macs), copy that content into the 'find' field as well as the 'replace' field.
Add a line break at the end of the content you pasted in the 'replace' field.
Execute the find-and-replace action.
This should turn something like this:
item
item
item
item
item
item
item
...into this:
item
item
item
item
item
item
item
...and so on.
This definitely isn't the most elegant solution, but is one of the quickest/simplest I've seen without resorting to a text parsing script in bash, etc.
Assuming data starts in A1, in B1 and copied down to suit (i.e. past the end of the cells populated in ColumnA):
=IF(MOD(ROW(),4)=0,"",OFFSET(A$1,3*INT((ROW()-1)/4)+MOD(ROW(),4)-1,))
Here is a VBA equivalent to the solution proposed by Eric K. above. The orientation assumes column header labels in row 1 that should be left alone.
Sub insBlankFourthRow()
Debug.Print Timer
With Worksheets("Sheet3")
.Columns(1).Insert
With .Cells(1, 1).CurrentRegion '<~~ original CurrentRegion
With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
.Cells(1, 1) = 1
.Cells.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
End With
With .Resize(Int(.Rows.Count / 3) + 1, 1).Offset(.Rows.Count, 0)
.Cells(1, 1) = 3.5
.Cells.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=3
End With
End With
'
With .Cells(1, 1).CurrentRegion '<~~ new expanded CurrentRegion
.Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes
End With
.Columns(1).Delete
End With
Debug.Print Timer
End Sub
tbh, ~2000 rows of data isn't that much to be worried about but 10× or 100× that amount of data will start to lag significantly when inserting rows individually or in a bulk non-contiguous orientation. A 'helper' column populated with a Range.DataSeries method (fastest way I know of populating a sequence) can be readily discarded once its purpose has been fulfilled.
Running the above against 2500 rows of random data typical of the image took ⁸⁄₁₀₀ of a second. That time might be moderately improved with disabling the Application.ScreenUpdating property and similar overhead.