Chỉ copy các cell hiện (không copy các cell ẩn = filter), và paste vào các cell hiện (không paste các cell ẩn = filter)

[AnhThu-1976]

Em chào các anh chị!
Em có sưu tầm code Paste dữ liệu bỏ qua các cột cell đã ẩn

Sub Paste_to_Visible_Rows()
Dim Nguon As Range, Dich As Range
Dim i As Long, r As Long
Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
Set Dich = Application.InputBox(prompt:="Chep Den: (luu y: chi chon 1 o dau tien cua vùng can dán nhé: ", Type:=8)
For i = 1 To Nguon.Rows.Count
Do Until Not Dich.Offset(r).Rows.Hidden
r = r + 1
Loop
Nguon.Rows(i).Copy Destination:=Dich.Offset(r)
r = r + 1
Next i
End Sub

Bây giờ muốn sửa Code trên như thế nào hoặc anh/chi viếp giúp code mới
P/s: cũng đã sửa nhưng chưa được
Trong file đính kèm, em copy cột A (A3:A7) và em muốn paste sang cột C
Em cảm ơn!

 

[phulien1902]

Em chào các anh chị!
Em có sưu tầm code Paste dữ liệu bỏ qua các cột cell đã ẩn

Sub Paste_to_Visible_Rows()
Dim Nguon As Range, Dich As Range
Dim i As Long, r As Long
Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
Set Dich = Application.InputBox(prompt:="Chep Den: (luu y: chi chon 1 o dau tien cua vùng can dán nhé: ", Type:=8)
For i = 1 To Nguon.Rows.Count
Do Until Not Dich.Offset(r).Rows.Hidden
r = r + 1
Loop
Nguon.Rows(i).Copy Destination:=Dich.Offset(r)
r = r + 1
Next i
End Sub

Bây giờ muốn sửa Code trên như thế nào hoặc anh/chi viếp giúp code mới
P/s: cũng đã sửa nhưng chưa được
Trong file đính kèm, em copy cột A (A3:A7) và em muốn paste sang cột C
Em cảm ơn!

Bạn thử:

Sub Paste_to_Visible_Rows()
    Dim Nguon As Range, Dich As Range
    Dim i As Long, r As Long
    Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
    Set Dich = Application.InputBox(prompt:="Chep Den: (luu y: chi chon 1 o dau tien cua vùng can dán nhé: ", Type:=8)
    For i = 1 To Nguon.Rows.Count
        Do Until Not Dich.Offset(r).Rows.Hidden
            r = r + 1
        Loop
        'Nguon.Rows(i).Copy Destination:=Dich.Offset(r)
        Nguon.SpecialCells(xlCellTypeVisible).Copy Destination:=Dich.Offset(r)
        'r = r + 1
    Next i
End Sub

 

[be_09]

Em chào các anh chị!
.................................
Trong file đính kèm, em copy cột A (A3:A7) và em muốn paste sang cột C
Em cảm ơn!

1/ Cách nhanh nhất mà chẳng cần đến Code:
Ẩn cột B: D, chọn vùng muốn Copy và Fill sang phải.

2/ Cách dùng Code mà không cần vòng lặp:

Sub Paste_to_Visible_Rows()
    Dim Nguon, Dich, Giatri As Range
    Set Nguon = Application.InputBox("Chon Vùng Copy", Type:=8)
    Set Dich = Application.InputBox("Cho cell dàu tiên càn gán", "Destination", Type:=8)
    Set Giatri = Range(Dich.Address, Cells(Dich.Row + Nguon.Rows.Count _
        - 1, Dich.Column + Nguon.Columns.Count - 1))
    Giatri = Nguon.Value
End Sub

 

[huynhkimtien]

Em chào các anh chị!
Em có sưu tầm code Paste dữ liệu bỏ qua các cột cell đã ẩn

Sub Paste_to_Visible_Rows()
Dim Nguon As Range, Dich As Range
Dim i As Long, r As Long
Set Nguon = Application.InputBox(prompt:="Chon Vung Copy ", Type:=8)
Set Dich = Application.InputBox(prompt:="Chep Den: (luu y: chi chon 1 o dau tien cua vùng can dán nhé: ", Type:=8)
For i = 1 To Nguon.Rows.Count
Do Until Not Dich.Offset(r).Rows.Hidden
r = r + 1
Loop
Nguon.Rows(i).Copy Destination:=Dich.Offset(r)
r = r + 1
Next i
End Sub

Bây giờ muốn sửa Code trên như thế nào hoặc anh/chi viếp giúp code mới
P/s: cũng đã sửa nhưng chưa được
Trong file đính kèm, em copy cột A (A3:A7) và em muốn paste sang cột C
Em cảm ơn!

Mình thấy trên mạng có code này bạn xem có giúp được gì ko nhé.
Sub Paste_Values_To_Filtered_Cells()
'Does not work with hidden columns, only with hidden rows


Dim SrcRng As Range
Dim SrcRngVisible As Range
Dim DestRng As Range
Dim SrcCell As Variant
Dim DestCell As Variant
Dim DestRngColumnCount As Long
Dim DestRngRowCount As Long
Dim msgAnswer As Variant


On Error Resume Next
'Select source range
Set SrcRng = Application.InputBox("Select source range", Default:=Selection.Address, Type:=8)
On Error GoTo 0
If SrcRng Is Nothing Then Exit Sub


On Error Resume Next
'Select destination range
Set DestRng = Application.InputBox("Select destination range", Type:=8)
On Error GoTo 0
If DestRng Is Nothing Then Exit Sub

Application.ScreenUpdating = False

'Calculate # of columns, # of rows, first column for later reference
SrcRngColumnCount = SrcRng.Columns.Count
DestRngColumnCount0 = DestRng.Columns.Count

'MsgBox "Dong: " & SrcRng.Rows.Count & Chr(10) & "Cot: " & SrcRngColumnCount

'Determines if the source and destination ranges have the same number of columns
If SrcRngColumnCount <> DestRngColumnCount0 Then _
Set DestRng = DestRng.Resize(SrcRng.Rows.Count, SrcRngColumnCount)
'MsgBox "Dong: " & DestRng.Rows.Count & Chr(10) & "Cot: " & DestRng.Columns.Count

DestRngColumnCount = DestRng.Columns.Count
DestRngRowCount = DestRng.Rows.Count
DestRngFirstColumn = DestRng.Cells(1, 1).Column


'Set source to only be visible cells
Set SrcRngVisible = SrcRng.SpecialCells(xlCellTypeVisible)


'Loops through each visible cell in the source range
For Each SrcCell In SrcRngVisible
If SrcCell.EntireRow.Hidden = False Then
'Loops through each cell in the destination range
For Each DestCell In DestRng
If DestCell.EntireRow.Hidden = False Then
'Only takes action if cell is visible (RowHeight is not 0)
If DestCell.EntireRow.RowHeight > 0 Then
'Source cell value is entered into destination cell if not empty text string
If SrcCell.Value <> "" Then
DestCell.Value = SrcCell.Value
'Bo sung dinh dang

End If

'Determines whether there are multiple columns of values that are being copied
If DestRngColumnCount > 1 Then
If DestCell.Column = DestRngFirstColumn + DestRngColumnCount - 1 Then
'Move to next row, reset column
Set DestRng = DestCell.Offset(1, (DestRngColumnCount - 1) * -1).Resize(DestRngRowCount, DestRngColumnCount)
Else
'Move to next column
Set DestRng = DestCell.Offset(0, 1).Resize(DestRngRowCount, DestRngColumnCount)
End If
Exit For
Else
'Move to next row
Set DestRng = DestCell.Offset(1, 0).Resize(DestRngRowCount, DestRngColumnCount)
Exit For
End If
End If
End If
Next
End If
Next


Application.ScreenUpdating = True


End Sub

 

[be_09]

Mình thấy trên mạng có code này bạn xem có giúp được gì ko nhé.
Sub Paste_Values_To_Filtered_Cells()
..........................................
End Sub[/CODE]

Cần gì phải chơi một đống code như thế, thử cái này:

Sub CopyBoQua_DongAn()
    Range("C1:C1000").FormulaR1C1 = "=RC[-2]"
    ActiveSheet.Range("$A$1").AutoFilter Field:=1
    Range("C1:C1000").Value = Range("C1:C1000").Value
End Sub

 

[tongjet]

Theo hướng dẫn này đơn giản và dễ hiểu, bằng cả hình ảnh luôn:

Paste dữ liệu, bỏ qua các cell ẩn

Xin chào mọi người. Tôi có việc này xin mọi người chỉ giáo. Giả sử tôi có 10 dòng dữ liệu từ 1-10. Bây giờ tôi muốn Paste vào dòng 11-22 mà trong đó có 2 dòng ẩn. Ý tôi là không Paste dữ liệu vào dòng ẩn. Xin cảm ơn.

www.giaiphapexcel.com