Cách duyệt qua từng sheet trong workbook ??

Quy Vu · 13/3/19

Chào các anh chị trong diễn đàn, em có một bài toán như sau
Cho file như tập đính kèm
Tạo sheet " Last city" ( e đã tạo)
Duyệt qua từng sheet, ở mỗi sheet lấy thủ đô ở dòng cuối cùng, sau đó tới sheet "Last city" và paste ở mỗi dòng
em viết được tới như này nhưng chạy code mà nó trả được kết quả từ mỗi sheet đầu, e kiểm tra kĩ mà không biết sai ở đâu? Mong được anh chị trợ giúp! Em cám ơn!

Mã:

Sub Last_Cities()
Dim Sh As Worksheet, d
     d = 1
   For Each Sh In Worksheets
          If Sh.Name <> "Last city" Then
               Range("A1").Select
               Selection.End(xlDown).Select
               Selection.Offset(0, 1).Copy
               Worksheets("Last city").Select
               Cells(d, 1).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
               d = d + 1
          End If
   Next Sh
End Sub

snow25 · 13/3/19

Quy Vu đã viết:
Chào các anh chị trong diễn đàn, em có một bài toán như sau
Cho file như tập đính kèm
Tạo sheet " Last city" ( e đã tạo)
Duyệt qua từng sheet, ở mỗi sheet lấy thủ đô ở dòng cuối cùng, sau đó tới sheet "Last city" và paste ở mỗi dòng
em viết được tới như này nhưng chạy code mà nó trả được kết quả từ mỗi sheet đầu, e kiểm tra kĩ mà không biết sai ở đâu? Mong được anh chị trợ giúp! Em cám ơn!

Mã:

Sub Last_Cities() Dim Sh As Worksheet, d d = 1 For Each Sh In Worksheets If Sh.Name <> "Last city" Then Range("A1").Select Selection.End(xlDown).Select Selection.Offset(0, 1).Copy Worksheets("Last city").Select Cells(d, 1).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False d = d + 1 End If Next Sh End Sub

Bạn chạy thử code này.

Mã:

Sub Last_Cities()
Dim Sh As Worksheet, lr, arr(1 To 1000, 1 To 1), a As Long
   For Each Sh In ThisWorkbook.Worksheets
          If Sh.Name <> "Last city" Then
              lr = Sh.Range("B" & Rows.Count).End(xlUp).Row
              a = a + 1
              arr(a, 1) = Sh.Range("B" & lr).Value
          End If
   Next
   With Sheets("Last city")
        lr = .Range("A" & Rows.Count).End(xlUp).Row + 1
        If a Then .Range("A" & lr).Resize(a, 1).Value = arr
   End With
End Sub

Mã:

Sub Last_Cities()
Dim Sh As Worksheet, lr, arr(1 To 1000, 1 To 1), a As Long
   For Each Sh In ThisWorkbook.Worksheets
          If Sh.Name <> "Last city" Then
              lr = Sh.Range("B" & Rows.Count).End(xlUp).Row
              a = a + 1
              arr(a, 1) = Sh.Range("B" & lr).Value
          End If
   Next
   With Sheets("Last city")
        lr = .Range("a" & Rows.Count).End(xlUp).Row
        .Range("A1:A" & lr).ClearContents
        If a Then .Range("A1").Resize(a, 1).Value = arr
   End With
End Sub

Quang_Hải · 13/3/19

Quy Vu đã viết:
Chào các anh chị trong diễn đàn, em có một bài toán như sau
Cho file như tập đính kèm
Tạo sheet " Last city" ( e đã tạo)
Duyệt qua từng sheet, ở mỗi sheet lấy thủ đô ở dòng cuối cùng, sau đó tới sheet "Last city" và paste ở mỗi dòng
em viết được tới như này nhưng chạy code mà nó trả được kết quả từ mỗi sheet đầu, e kiểm tra kĩ mà không biết sai ở đâu? Mong được anh chị trợ giúp! Em cám ơn!

Mã:

Sub Last_Cities() Dim Sh As Worksheet, d d = 1 For Each Sh In Worksheets If Sh.Name <> "Last city" Then Range("A1").Select Selection.End(xlDown).Select Selection.Offset(0, 1).Copy Worksheets("Last city").Select Cells(d, 1).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False d = d + 1 End If Next Sh End Sub

Thử code này. Chú ý code không có bẫy lỗi

Mã:

Sub Last_City()
Dim sh As Worksheet, res(1 To 1000, 1 To 1), k As Long, sArr()
For Each sh In ThisWorkbook.Worksheets
   If LCase(sh.Name) <> "last city" Then
      sArr = sh.[A1].CurrentRegion.Value
      k = k + 1
      res(k, 1) = sArr(UBound(sArr), 2)
   End If
Next
Sheets("Last City").[A1].Resize(k, 1) = res
End Sub

Quy Vu · 13/3/19

snow25 đã viết:

Bạn chạy thử code này.

Mã:

Sub Last_Cities()
Dim Sh As Worksheet, lr, arr(1 To 1000, 1 To 1), a As Long
   For Each Sh In ThisWorkbook.Worksheets
          If Sh.Name <> "Last city" Then
              lr = Sh.Range("B" & Rows.Count).End(xlUp).Row
              a = a + 1
              arr(a, 1) = Sh.Range("B" & lr).Value
          End If
   Next
   With Sheets("Last city")
        lr = .Range("A" & Rows.Count).End(xlUp).Row + 1
        If a Then .Range("A" & lr).Resize(a, 1).Value = arr
   End With
End Sub

Mã:

Sub Last_Cities()
Dim Sh As Worksheet, lr, arr(1 To 1000, 1 To 1), a As Long
   For Each Sh In ThisWorkbook.Worksheets
          If Sh.Name <> "Last city" Then
              lr = Sh.Range("B" & Rows.Count).End(xlUp).Row
              a = a + 1
              arr(a, 1) = Sh.Range("B" & lr).Value
          End If
   Next
   With Sheets("Last city")
        lr = .Range("a" & Rows.Count).End(xlUp).Row
        .Range("A1:A" & lr).ClearContents
        If a Then .Range("A1").Resize(a, 1).Value = arr
   End With
End Sub

a có biết code e bị lỗi gì mà không ạ? e ngồi đọc thấy cũng ok, mà k hiểu sao nó không chạy?

Bài đã được tự động gộp: 13/3/19

quanghai1969 đã viết:

Thử code này. Chú ý code không có bẫy lỗi

Mã:

Sub Last_City()
Dim sh As Worksheet, res(1 To 1000, 1 To 1), k As Long, sArr()
For Each sh In ThisWorkbook.Worksheets
   If LCase(sh.Name) <> "last city" Then
      sArr = sh.[A1].CurrentRegion.Value
      k = k + 1
      res(k, 1) = sArr(UBound(sArr), 2)
   End If
Next
Sheets("Last City").[A1].Resize(k, 1) = res
End Sub

a có biết code em bị lỗi gì không ạ? em đọc thấy cũng ok mà sao không thấy chạy! em cám ơn!

snow25 · 13/3/19

Quy Vu đã viết:
a có biết code e bị lỗi gì mà không ạ? e ngồi đọc thấy cũng ok, mà k hiểu sao nó không chạy?

Bài đã được tự động gộp: 13/3/19

a có biết code em bị lỗi gì không ạ? em đọc thấy cũng ok mà sao không thấy chạy! em cám ơn!

Bạn chạy F8 xem nó chạy thế nào.

Quang_Hải · 14/3/19

Quy Vu đã viết:
a có biết code e bị lỗi gì mà không ạ? e ngồi đọc thấy cũng ok, mà k hiểu sao nó không chạy?

Bài đã được tự động gộp: 13/3/19

a có biết code em bị lỗi gì không ạ? em đọc thấy cũng ok mà sao không thấy chạy! em cám ơn!

Code của bạn cũng gần đúng, sai có tí xíu thôi.
Tạm sửa theo code của bạn. Đọc rồi ngâm cứu nhé

Sub Last_Cities()
Dim Sh As Worksheet, d
d = 1
For Each Sh In Worksheets
If Sh.Name <> "Last city" Then
Sh.Range("A1").Offset(, 1).End(xlDown).Copy
Worksheets("Last city").Select
Cells(d, 1).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
d = d + 1
End If
Next Sh
End Sub

Phuocam · 14/3/19

Quy Vu đã viết:
a có biết code e bị lỗi gì mà không ạ? e ngồi đọc thấy cũng ok, mà k hiểu sao nó không chạy?

Thêm dòng này:
Sh.Select

PHP:

Sub Last_Cities()
Dim Sh As Worksheet, d
     d = 1
   For Each Sh In Worksheets
          If Sh.Name <> "Last city" Then
          Sh.Select' Thêm dòng này
               Range("A1").Select
               Selection.End(xlDown).Select
               Selection.Offset(0, 1).Copy
               Worksheets("Last city").Select
               Cells(d, 1).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
               d = d + 1
          End If
   Next Sh
End Sub

Quy Vu · 14/3/19

quanghai1969 đã viết:

Thử code này. Chú ý code không có bẫy lỗi

Mã:

Sub Last_City()
Dim sh As Worksheet, res(1 To 1000, 1 To 1), k As Long, sArr()
For Each sh In ThisWorkbook.Worksheets
   If LCase(sh.Name) <> "last city" Then
      sArr = sh.[A1].CurrentRegion.Value
      k = k + 1
      res(k, 1) = sArr(UBound(sArr), 2)
   End If
Next
Sheets("Last City").[A1].Resize(k, 1) = res
End Sub

em chạy thử code này thấy không chạy a ạ! e thấy lỗi ở dòng này res(k, 1) = sArr(UBound(sArr), 2)

Quang_Hải · 15/3/19

Quy Vu đã viết:
em chạy thử code này thấy không chạy a ạ! e thấy lỗi ở dòng này res(k, 1) = sArr(UBound(sArr), 2)

Mình đã nói rồi, code không có bẫy lỗi. Nếu code không sử dụng được thì phải đính kèm file để mọi người xem coi file thật và file ban đầu có khác nhau hay không

Quy Vu · 18/3/19

quanghai1969 đã viết:
Mình đã nói rồi, code không có bẫy lỗi. Nếu code không sử dụng được thì phải đính kèm file để mọi người xem coi file thật và file ban đầu có khác nhau hay không

Đây a ạ, a xem giúp em!

CHAOQUAY · 18/3/19

Quy Vu đã viết:
Đây a ạ, a xem giúp em!

code của bạn chỉ copy được sheet đầu tiên không phải sheet cuối cùng
Trong code của bạn, sau khi copy lần đầu, sheet hiện hành sẽ là Last city ( Worksheets("Last city").Select ) ---> Từ lúc này trở đi các câu lệnh select, copy, offset… đều chỉ thực hiện trên sheet Last city nên kết quả vẫn y nguyên
Bạn chạy thử code duới đây xem sao

Mã:

Sub Last_Cities()
Dim Sh As Worksheet, d
     d = 1
   For Each Sh In Worksheets
          If Sh.Name <> "Last city" Then
               'Range("A1").Select
               'Selection.End(xlDown).Select
               'Selection.Offset(0, 1).Copy
               Sh.Range("A1").End(xlDown).Offset(, 1).Copy
               Worksheets("Last city").Select
               Cells(d, 1).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
               d = d + 1
          End If
   Next Sh
End Sub

Ba Tê · 19/3/19

Quy Vu đã viết:
Duyệt qua từng sheet, ở mỗi sheet lấy thủ đô ở dòng cuối cùng, sau đó tới sheet "Last city" và paste ở mỗi dòng

Với yêu cầu như vậy thì bạn có thể sửa code như vầy để khỏi phải select sheet "nhảy lung tung".

PHP:

Sub Last_City()
Dim Sh As Worksheet, d
For Each Sh In Worksheets
    If Sh.Name <> "Last city" Then
        d = d + 1
        Sheets("Last city").Range("A" & d).Value = Sheets(Sh.Name).Range("B10000").End(xlUp).Value
    End If
Next Sh
End Sub

Quang_Hải · 19/3/19

Quy Vu đã viết:
Đây a ạ, a xem giúp em!

Với file trong bài số 10 thì code chạy bình thường. Nếu bạn nói không chạy thì hãy đợi thành viên khác giúp nhé. Khả năng mình chỉ có vậy

be_09 · 19/3/19

Quy Vu đã viết:
Chào các anh chị trong diễn đàn, em có một bài toán như sau
Cho file như tập đính kèm
Tạo sheet " Last city" ( e đã tạo)
Duyệt qua từng sheet, ở mỗi sheet lấy thủ đô ở dòng cuối cùng, sau đó tới sheet "Last city" và paste ở mỗi dòng
em viết được tới như này nhưng chạy code mà nó trả được kết quả từ mỗi sheet đầu, e kiểm tra kĩ mà không biết sai ở đâu? Mong được anh chị trợ giúp! Em cám ơn!

Mã:

Sub Last_Cities() Dim Sh As Worksheet, d d = 1 For Each Sh In Worksheets If Sh.Name <> "Last city" Then Range("A1").Select Selection.End(xlDown).Select Selection.Offset(0, 1).Copy Worksheets("Last city").Select Cells(d, 1).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False d = d + 1 End If Next Sh End Sub

Tôi thắc mắc:
Tại sao không Copy cả dòng cuối mà chỉ Copy cell cuối của cột B?

Quy Vu · 20/3/19

be09 đã viết:
Tôi thắc mắc:
Tại sao không Copy cả dòng cuối mà chỉ Copy cell cuối của cột B?

kkk, đề ra như vậy a ạ!

Cách duyệt qua từng sheet trong workbook ??

Quy Vu

Thành viên chính thức

File đính kèm

snow25

Thành viên gạo cội

Quang_Hải

Thành viên gạo cội

Quy Vu

Thành viên chính thức

snow25

Thành viên gạo cội

Quang_Hải

Thành viên gạo cội

Phuocam

Thành viên mới

Quy Vu

Thành viên chính thức

Quang_Hải

Thành viên gạo cội

Quy Vu

Thành viên chính thức

File đính kèm

CHAOQUAY

Thành viên gắn bó

Ba Tê

Cạo Rồi Khỏi Gội

Quang_Hải

Thành viên gạo cội

be_09

Biên Hòa, Đồng Nai

Quy Vu

Thành viên chính thức

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian