asked on How do I copy only filled cells with a macro?
I need to copy cells that have been filled from one sheet to other sheet.
The cells to be copied on sheet1 are B7:21 & E7:11 & H7:16. They need to be paste on sheet2 all in one column A1 with NO blank spaces. (see file)
Here is the hard part:
Sheet1 columns will be B E H K N Q T W. These columns will change on how many cells are filled with serial numbers, I still need to copy and all of them on sheet2 in column A with no blank spaces.
I have added a file to help explain.
Jimi
Labs-Seattle-Equip-Scan-V1.1-xxx.xlsx
The cells to be copied on sheet1 are B7:21 & E7:11 & H7:16. They need to be paste on sheet2 all in one column A1 with NO blank spaces. (see file)
Here is the hard part:
Sheet1 columns will be B E H K N Q T W. These columns will change on how many cells are filled with serial numbers, I still need to copy and all of them on sheet2 in column A with no blank spaces.
I have added a file to help explain.
Jimi
Labs-Seattle-Equip-Scan-V1.1-xxx.xlsx
Microsoft ExcelVB Script
Last Comment
eureka15
I see your suggested output in Sheet 2.
Here's your code:
see attached,
Dave
Labs-Seattle-Equip-Scan-V1.1-xxx.xlsm
Here's your code:
Sub copyFilledCells()
Dim colsToCopy() As String
colsToCopy = Split("B,E,H,K,N,Q,T,W", ",") 'get columns to copy into an array
Sheet1.Activate 'start on the first sheet, where the data is
Sheet2.Cells.ClearContents 'clear output sheet
For i = 0 To UBound(colsToCopy)
Call copyColumn(colsToCopy(i), Sheet1, Sheet2)
Next i
MsgBox "Done!"
Sheet2.Activate
End Sub
Sub copyColumn(colLetter As String, shIn As Worksheet, shOut As Worksheet)
Dim myCell As Range
If Range(colLetter & Rows.Count).End(xlUp).Row < 7 Then Exit Sub 'no data here
For Each myCell In shIn.Range(colLetter & "7", Range(colLetter & Rows.Count).End(xlUp)) 'row 7 to to the last row with data, with column requested
shOut.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = myCell.Value 'put value in row to the next available cell in column A of output sheet
Next myCell
End Sub
see attached,
Dave
Labs-Seattle-Equip-Scan-V1.1-xxx.xlsm
Ah - one final touch - to test if A1 has data... a slight mod adding if statment in the copyColumn() routine.
just run the macro: copyFilledCells()
here's the final code - note Sheet1 and Sheet2 are objects - you can change their names, replacing those with Sheets("Sheet1") or whatever, and the app will work just fine.
Enjoy!
Dave
Labs-Seattle-Equip-Scan-V1.1-xxx.xlsm
just run the macro: copyFilledCells()
here's the final code - note Sheet1 and Sheet2 are objects - you can change their names, replacing those with Sheets("Sheet1") or whatever, and the app will work just fine.
Sub copyFilledCells()
Dim colsToCopy() As String
colsToCopy = Split("B,E,H,K,N,Q,T,W", ",") 'get columns to copy into an array
Sheet1.Activate 'start on the first sheet, where the data is
Sheet2.Cells.ClearContents 'clear output sheet
For i = 0 To UBound(colsToCopy)
Call copyColumn(colsToCopy(i), Sheet1, Sheet2)
Next i
MsgBox "Done!"
Sheet2.Activate
End Sub
Sub copyColumn(colLetter As String, shIn As Worksheet, shOut As Worksheet)
Dim myCell As Range
If Range(colLetter & Rows.Count).End(xlUp).Row < 7 Then Exit Sub 'no data here
For Each myCell In shIn.Range(colLetter & "7", Range(colLetter & Rows.Count).End(xlUp)) 'row 7 to to the last row with data, with column requested
If shOut.Range("A1").Value = "" Then
shOut.Range("A1").Value = myCell.Value
Else
shOut.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = myCell.Value 'put value in row to the next available cell in column A of output sheet
End If
Next myCell
End Sub
Enjoy!
Dave
Labs-Seattle-Equip-Scan-V1.1-xxx.xlsm
Here is mine
Sub collatecols()
For i = 2 To 24 Step 3
If Sheet1.Cells(7, i) <> "" Then
Sheet1.Range(Sheet1.Cells(7, i), Sheet1.Cells(Sheet1.Cells(Rows.Count, i).End(xlUp).Row, i)).Copy Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next i
End Sub
Clever - I wrote mine anticipating future use, if the columns to copy were to change, lol....
@ssagibh - You might want to ensure your code puts data in Range("A1") of the output sheet, as well :)
Cheers,
Dave
@ssagibh - You might want to ensure your code puts data in Range("A1") of the output sheet, as well :)
Cheers,
Dave
ASKER CERTIFIED SOLUTION
THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
How about
if sheet2.range("A1")="" then sheet2.range("A1").entirer
before the end sub
if sheet2.range("A1")="" then sheet2.range("A1").entirer
before the end sub
To improve readability you can use
Sub collatecols()
For i = 2 To 24 Step 3
Set fr = Sheet1.Cells(7, i)
If fr <> "" Then
Set lr = Sheet1.Cells(Sheet1.Cells(Rows.Count, i).End(xlUp).Row, i)
Set tr = Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Sheet1.Range(fr, lr).Copy tr
End If
Next i
If Sheet2.Range("A1") = "" Then Sheet2.Range("A1").EntireRow.Delete
End Sub
ASKER
WOW! I went to dinner and came back to all this great info!
Thanks guys
Jimi
Thanks guys
Jimi
Pleasure is mine/ours.
PS - if your columns to copy change in future, just change this code to represent that:
colsToCopy = Split("B,E,H,K,N,Q,T,W", ",") 'get columns to copy into an array
Cheers,
Dave
PS - if your columns to copy change in future, just change this code to represent that:
colsToCopy = Split("B,E,H,K,N,Q,T,W", ",") 'get columns to copy into an array
Cheers,
Dave
ASKER
Thanks Dave
Great fore site Dave...this file will go to 18 offices AND there will be future add-on columns you BET!
Great fore site Dave...this file will go to 18 offices AND there will be future add-on columns you BET!
ASKER
ssaqibh:
It is really cool how simple simple and small your code was...WOW!
I went with Dave's due to it could be easily changed in the future.
Thanks :D
It is really cool how simple simple and small your code was...WOW!
I went with Dave's due to it could be easily changed in the future.
Thanks :D
I am fine with the acceptance. But you can extend mine too by increasing the 24 on line 2. In fact you can give it a large number to start with and the program will only copy if the column contains data. This program will only fail if the spacing of the copied columns is not regular. At the moment the columns are on a spacing of three. You can easily change the spacing on the same line.
ASKER
ssaqibh:
Oh OK that is good to know, Thanks or the info :D
Oh OK that is good to know, Thanks or the info :D
Please explain what the output in column A looks like for Sheet 2, the first couple rows.
Dave