VBA Copy cách cột (1 người xem)

[hongphuong1997]

Em nhờ thầy cô và anh chị viết giúp code copy cách cột như file đính kèm
Em xin cảm ơn.

 

[huuthang_bd]

Em nhờ thầy cô và anh chị viết giúp code copy cách cột như file đính kèm
Em xin cảm ơn.

Cái này record macro rồi sửa lại là có ngay mà bạn.

Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("1").Range("B4:B7").Copy Sheets("2").Range("AA3")
    Sheets("1").Range("C4:C7").Copy Sheets("2").Range("AH3")
    '...
End Sub

Nói vậy thôi chứ chắc mấy chục bài mới xong

 

[befaint]

Mình chỉ tò mò vào xem chủ đề này sẽ kéo dài mấy chục bài vì chưa thấy chủ đề nào dưới 10 bài.

Vì: Ghi macro đúng với bài mẫu rồi, lúc sau lại nhưng mà còn... Híc.

 

[lameco411]

Em nhờ thầy cô và anh chị viết giúp code copy cách cột như file đính kèm
Em xin cảm ơn.

Mình cũng đang định hỏi vấn đề y như bạn vậy. Ví dụ mình có một cột đã lọc ra ngày tháng và tên khách hàng. Giờ mình muốn copy ra bên sheet khác mà không copy cột khách hàng. Không lẽ chọn từ cột này tới cột kia, rồi cột kia tới cột nọ ta?

 

[hongphuong1997]

Cái này record macro rồi sửa lại là có ngay mà bạn.

Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("1").Range("B4:B7").Copy Sheets("2").Range("AA3")
    Sheets("1").Range("C4:C7").Copy Sheets("2").Range("AH3")
    '...
End Sub

Nói vậy thôi chứ chắc mấy chục bài mới xong

Hi hi..... chịu anh đấy.
Anh đừng trêu em nữa
Anh viết giúp em với anh

 

[huuthang_bd]

Hi hi..... chịu anh đấy.
Anh đừng trêu em nữa
Anh viết giúp em với anh

Tôi viết cho bạn đấy chứ trêu gì bạn. Code đấy sai chỗ nào? Bạn bổ sung thêm mấy dòng nữa tương tự như các dòng đã có là xong.
Bổ sung Code cho yêu cầu 2:

Sub Macro2()
'
' Macro2 Macro
'

'
    Sheets("2").Range("AA3:AA6,AH3:AH6,AO3:AO6,AV3:AV6,BC3:BC6,BJ3:BJ6").Copy Sheets("1").Range("O25")
End Sub

 

[hongphuong1997]

Tôi viết cho bạn đấy chứ trêu gì bạn. Code đấy sai chỗ nào? Bạn bổ sung thêm mấy dòng nữa tương tự như các dòng đã có là xong.
Bổ sung Code cho yêu cầu 2:

Sub Macro2()
'
' Macro2 Macro
'

'
    Sheets("2").Range("AA3:AA6,AH3:AH6,AO3:AO6,AV3:AV6,BC3:BC6,BJ3:BJ6").Copy Sheets("1").Range("O25")
End Sub

hu hu..... nhưng mà em có mấy ngàn cột thì cứ làm như vậy đến bao giờ hở anh?
Anh viết cẩn thận cho em đi
Cảm ơn anh

 

[huuthang_bd]

hu hu..... nhưng mà em có mấy ngàn cột thì cứ làm như vậy đến bao giờ hở anh?
Anh viết cẩn thận cho em đi
Cảm ơn anh

Yêu cầu thế nào tôi đã viết thế ấy, và đã rất cẩn thận.

1- Copy cột B4-B7 sang cột (AA3-AA6) của sheet"2"
Copy cột c4-c7 sang cột (Ah3-Ah6) của sheet"2"
Và cứ lần lượt như vậy đến hết 6 cột

Còn thông tin "mấy ngàn cột" là thông tin mới.
Thế nhé.

 

[hongphuong1997]

Yêu cầu thế nào tôi đã viết thế ấy, và đã rất cẩn thận.

Còn thông tin "mấy ngàn cột" là thông tin mới.
Thế nhé.

Em biết là anh gợi ý để cho em làm
Nhưng mờ em chưa biết dùng for....Next
Anh viết giúp em tý tẹo thôi mờ
Anh viết giúp em nhé

 

[befaint]

Bài thứ 9. Theo #2 thì tầm mấy chục...lận!

Ha ha. Mới có 1 "nhưng mà" đã nhảy từ 6 lên hàng ngàn. Em thích khúc này.

 

[hongphuong1997]

Ha ha. Mới có 1 "nhưng mà" đã nhảy từ 6 lên hàng ngàn. Em thích khúc này.

Cả Bác này nữa
Biết roài mà không giúp cháu
Cháu đang viết và sửa nhưng mờ chẳng được bác à
Sub CopyVung4()
Dim i As Integer
For i = 3 To 11
Range("a4:&i,i").copy Cells(4, i + 6)
Next i
End Sub

 

[huuthang_bd]

Em biết là anh gợi ý để cho em làm
Nhưng mờ em chưa biết dùng for....Next
Anh viết giúp em tý tẹo thôi mờ
Anh viết giúp em nhé

Tôi thấy bạn hỏi nhiều và đã được nhắc nhở nhiều nhưng sao vẫn không rút kinh nghiệm?
Lần cuối nhé.

Const CachQuang As Long = 7
Sub Test1()
CopyXuoi Sheets("1").Range("B4:G7"), Sheets("2").Range("AA3")
End Sub
Sub Test2()
CopyNguoc Sheets("1").Range("O25:T25"), Sheets("2").Range("AA3:AA6")
End Sub
Private Sub CopyXuoi(Rng1 As Range, Rng2 As Range)
Dim i As Long
For i = 1 To Rng1.Columns.Count
    Rng1.Columns(i).Copy Rng2.Cells(1, (i - 1) * CachQuang + 1)
Next
End Sub
Private Sub CopyNguoc(Rng1 As Range, Rng2 As Range)
Dim i As Long
For i = 1 To Rng1.Columns.Count
    Rng2.Offset(, (i - 1) * CachQuang).Copy Rng1.Cells(1, i)
Next
End Sub

 

[hongphuong1997]

Tôi thấy bạn hỏi nhiều và đã được nhắc nhở nhiều nhưng sao vẫn không rút kinh nghiệm?
Lần cuối nhé.

Const CachQuang As Long = 7
Sub Test1()
CopyXuoi Sheets("1").Range("B4:G7"), Sheets("2").Range("AA3")
End Sub
Sub Test2()
CopyNguoc Sheets("1").Range("O25:T25"), Sheets("2").Range("AA3:AA6")
End Sub
Private Sub CopyXuoi(Rng1 As Range, Rng2 As Range)
Dim i As Long
For i = 1 To Rng1.Columns.Count
    Rng1.Columns(i).Copy Rng2.Cells(1, (i - 1) * CachQuang + 1)
Next
End Sub
Private Sub CopyNguoc(Rng1 As Range, Rng2 As Range)
Dim i As Long
For i = 1 To Rng1.Columns.Count
    Rng2.Offset(, (i - 1) * CachQuang).Copy Rng1.Cells(1, i)
Next
End Sub

Hi hi.... em cảm ơn anh nhiều nhiều nhé!

 

[SA_DQ]

Cách làm là vầy:
Lập bảng cột nguôn (chép) & đích (đến), như sau:

Cột đi      Cột đến
  2              27
  3              34
  4              41
  5              48

Ta sẽ có qui luật sau:
(2 +1) *7 + 6 => 27
(3 + 1) * 7 + 6 => 34
(4 + 1) * 7 + 6 => 41
. . . .

 For Col = 2 to  Num
  Cells(4, Col).Resize( Rws). Copy Destination:= Sheets("2").Cells(3, (1+ Col)*7 + 6)
 Next Col

 

[hongphuong1997]

Cách làm là vầy:
Lập bảng cột nguôn (chép) & đích (đến), như sau:

Cột đi      Cột đến
  2              27
  3              34
  4              41
  5              48

Ta sẽ có qui luật sau:
(2 +1) *7 + 6 => 27
(3 + 1) * 7 + 6 => 34
(4 + 1) * 7 + 6 => 41
. . . .

For Col = 2 to  Num
  Cells(4, Col).Resize( Rws). Copy Destination:= Sheets("2").Cells(3, (1+ Col)*7 + 6)
Next Col

Cháu cảm ơn Bác
SA_DQ
Code của bác rất dễ hiểu,
Đặc biệt là những người đang mò mẫm học như chúng cháu sẽ nhanh chóng tiếp thu được
Cháu cảm ơn Bác rất nhiều.