Note: The other languages of the website are Google-translated. Back to English

Excel'deki hücre değerine göre tüm satırı başka bir sayfaya nasıl taşıyabilirim?

Hücre değerine göre satırın tamamını başka bir sayfaya taşımak için bu makale size yardımcı olacaktır.

VBA kodu ile hücre değerine göre tüm satırı başka bir sayfaya taşıyın
Kutools for Excel ile tüm satırı hücre değerine göre başka bir sayfaya taşıyın


VBA kodu ile hücre değerine göre tüm satırı başka bir sayfaya taşıyın

Aşağıda gösterilen ekran görüntüsü gibi, C sütununda belirli bir "Bitti" kelimesi varsa, tüm satırı Sayfa1'den Sayfa2'ye taşımanız gerekir. Aşağıdaki VBA kodunu deneyebilirsiniz.

1. Basın Ara Toplam+ F11 anahtarları aynı anda açmak için Uygulamalar için Microsoft Visual Basic pencere.

2. Uygulamalar için Microsoft Visual Basic penceresinde, Ekle > modül. Ardından aşağıdaki VBA kodunu kopyalayıp pencereye yapıştırın.

VBA code 1: Move entire row to another sheet based on cell value

Sub Cheezy()
'Updated by Kutools for Excel 2017/8/28
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Done" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

not: Kodda, Sheet1 çalışma sayfası taşımak istediğiniz satırı içerir. Ve Sheet2 satırı bulacağınız hedef çalışma sayfasıdır. "C: C"Sütun, belirli bir değeri içerir ve"tamam"Satırı temel alarak taşıyacağınız belirli değerdir. Lütfen ihtiyaçlarınıza göre değiştirin.

3. Tuşuna basın. F5 kodu çalıştırmak için tuşuna basın, ardından Sayfa1'deki kriterleri karşılayan satır hemen Sayfa2'ye taşınacaktır.

not: Yukarıdaki VBA kodu, belirli bir çalışma sayfasına geçtikten sonra orijinal verilerden satırları silecektir. Satırları silmek yerine yalnızca hücre değerine göre kopyalamak istiyorsanız. Lütfen aşağıdaki VBA kodunu uygulayın 2.

VBA code 2: Copy entire row to another sheet based on cell value

Sub MoveRowBasedOnCellValue()
'Updated by Extendoffice 2017/11/10
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Kutools for Excel ile tüm satırı hücre değerine göre başka bir sayfaya taşıyın

VBA kodunda acemi iseniz. Burada tanıtıyorum Belirli Hücreleri Seçin yarar Kutools for Excel. Bu yardımcı program ile, bir çalışma sayfasındaki belirli bir hücre değerine veya farklı hücre değerlerine göre tüm satırları kolayca seçebilir ve seçilen satırları ihtiyaç duyduğunuz şekilde hedef çalışma sayfasına kopyalayabilirsiniz. Lütfen aşağıdaki işlemleri yapın.

Başvurmadan önce Kutools for ExcelLütfen önce indirin ve kurun.

1. Satırları temel alarak taşıyacağınız hücre değerini içeren sütun listesini seçin ve ardından Kutools > seçmek > Belirli Hücreleri Seçin. Ekran görüntüsüne bakın:

2. Açılışta Belirli Hücreleri Seçin diyalog kutusunu seçiniz Tüm satır içinde Seçim türü bölümünde, seçin eşittir içinde Belirli tür açılır listede hücre değerini metin kutusuna girin ve ardından OK düğmesine basın.

Başka Belirli Hücreleri Seçin size seçilen satırların sayısını göstermek için iletişim kutusu açılır ve bu arada, tüm satırlar seçilen sütunda belirtilen değeri içerir. Ekran görüntüsüne bakın:

3. Tuşuna basın. Ctrl + C Seçili satırları kopyalamak ve ardından bunları ihtiyacınız olan hedef çalışma sayfasına yapıştırmak için tuşlarına basın.

not: Satırları iki farklı hücre değerine göre başka bir çalışma sayfasına taşımak istiyorsanız. Örneğin, satırları "Bitti" veya "İşleniyor" değerlerine göre taşıyın Or durumdaki Belirli Hücreleri Seçin aşağıda gösterilen ekran görüntüsü gibi iletişim kutusu:

  Ücretsiz deneme yapmak istiyorsanız (30-gün) bu yardımcı programın, indirmek için lütfen tıklayınızve ardından yukarıdaki adımlara göre işlemi uygulamaya gidin.


İlgili Makaleler:


En İyi Ofis Üretkenliği Araçları

Kutools for Excel Sorunlarınızın Çoğunu Çözer ve Verimliliğinizi% 80 Artırır

  • Yeniden: Hızlıca yerleştirin karmaşık formüller, grafikler ve daha önce kullandığınız her şey; Hücreleri Şifrele şifre ile; Posta Listesi Oluşturun ve e-posta gönder ...
  • Süper Formül Çubuğu (birden çok metin ve formül satırını kolayca düzenleyin); Okuma Düzeni (çok sayıda hücreyi kolayca okuyun ve düzenleyin); Filtrelenmiş Aralığa Yapıştır...
  • Hücreleri / Satırları / Sütunları Birleştirme Veri kaybetmeden; Bölünmüş Hücre İçeriği; Yinelenen Satırları / Sütunları Birleştirme... Yinelenen Hücreleri Önleyin; Aralıkları Karşılaştır...
  • Yinelenen veya Benzersiz'i seçin Satırlar; Boş Satırları Seçin (tüm hücreler boştur); Süper Bul ve Bulanık Bul Birçok Çalışma Kitabında; Rastgele Seçim ...
  • Tam kopya Formül referansını değiştirmeden Birden Çok Hücre; Otomatik Referans Oluştur Birden Çok Sayfaya; Madde İşaretleri Ekle, Onay Kutuları ve daha fazlası ...
  • Metni Çıkar, Metin Ekle, Konuma Göre Kaldır, Alanı Kaldır; Sayfalama Alt Toplamları Oluşturma ve Yazdırma; Hücre İçeriği ve Yorumları Arasında Dönüştür...
  • Süper Filtre (filtre şemalarını kaydedin ve diğer sayfalara uygulayın); Gelişmiş Sıralama ay / hafta / gün, sıklık ve daha fazlasına göre; Özel Filtre kalın, italik ...
  • Çalışma Kitaplarını ve Çalışma Sayfalarını Birleştirin; Tabloları anahtar sütunlara göre birleştirin; Verileri Birden Çok Sayfaya Bölme; Toplu dönüştürme xls, xlsx ve PDF...
  • 300'den fazla güçlü özellik. Office / Excel 2007-2021 ve 365'i destekler. Tüm dilleri destekler. Kuruluşunuzda veya kuruluşunuzda kolay devreye alma. Tam özellikler 30 günlük ücretsiz deneme. 60 günlük para iade garantisi.
kte sekmesi 201905

Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir

  • Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
  • Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
  • Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
ofis tabanı
Yorumları sıralama ölçütü
Yorumlar (299)
Henüz derecelendirme yok. İlk değerlendiren siz olun!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, bu özel kılavuzu gördüğüm diğerlerine göre gerçekten yararlı buldum. Teşekkür ederim! Karşılaştığım sorun şu ki, eğer istediğim değeri 'Kapalı' olarak değiştirirsem, satırı taşımak için F5'i çalıştırmam gerekiyor. Otomatik olarak hareket etmesini istiyorum. Excel'de yeniyim, bu yüzden yardımınız çok takdir ediliyor. Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I Uzun Dim J As Long I = Worksheets("ECR Incident Tracker").UsedRange.Rows.Count J = Worksheets("Çözülmüş Sorunlar").UsedRange.Rows. Say J = 1 ise, Sonra If Application.WorksheetFunction.CountA(Worksheets("Resolved Issues").UsedRange) = 0 O zaman J = 0 End If Set xRg = Worksheets("ECR Incident Tracker").Range("B1:B" & I) Hatada Sonraki Application.ScreenUpdating = False xRg'deki Her xCell İçin CStr(xCell.Value) = "Kapalı" ise xCell.EntireRow.Copy Destination:=Worksheets("Çözülmüş Sorunlar").Range("A" & J + 1) xCell.EntireRow.Delete J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, modülü açıp F5'e basmadan hücreleri hareket ettirmeyi otomatikleştirmeye çalışıyorum. Bu soruyu hiç çözdün mü? Şimdiden teşekkür ederim!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Crystal bugün bunun nasıl yapılacağı hakkında bilgi verdi - yanıtını görmek için bu ileti dizisinin birinci sayfasına bakın. Bir sütunda bugünün tarihi olan satırı (benim durumumda L) otomatik olarak farklı bir çalışma sayfasına taşır.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu kodu çalıştırıyorum ve I sütununda görünen bugünün tarihine göre bir satırı taşımaya çalışıyorum - Range("B1:B" & I) öğesini Range(I1:I" & I) olarak değiştirdim. Değiştirdim " Tarih örneğinde Bitti". Ancak, bugünün tarihi gerektiği gibi yalnızca I sütununda değil, satırın herhangi bir yerinde göründüğünde, satır alternatif çalışma sayfasına taşınır. Bunun neden olduğu ve satırı nasıl hareket ettirebileceğim hakkında herhangi bir fikriniz var mı? sadece bugünün tarihi sütun I'de olduğunda, bugünün tarihinin diğer sütunlarda görünüp görünmediğine bakılmaksızın?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Satırımı taşımak için çok sayıda değere ve çok sayıda sayfaya sahip olmak isteseydim, tüm kodu o hücre için farklı bir değerle yeniden yazmam gerekir miydi? Yani bir hücreye NA koyarsam Na sayfasına gider, W# koyarsam yanlış numara sayfasına gider vb.
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba, bu çok yardımcı oldu. Bunu, veri satırını ikinci sayfaya taşımadan, bunun yerine kopyalatmadan yapmanın bir yolu var mı? Yani veriler her iki sayfada da mı kalacak?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, kod çok yardımcı oldu, ancak tüm satırı kopyalamak yerine, belirli bir satır seçiminin bir sonraki sayfaya taşınmasını istiyorum. tüm satır yerine bir aralığı nasıl tanımlayabilirim Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I As Long Dim J As Long I = Worksheets("Sheet1").UsedRange.Rows.Count J = Worksheets(" Sheet2").UsedRange.Rows.Count J = 1 ise Sonra Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 O zaman J = 0 End If Set xRg = Worksheets("Sheet1").Range( "C1:C" & I) Hatada Sonraki Uygulamaya Devam Et.ScreenUpdating = xRg'deki Her xCell İçin Yanlış CStr(xCell.Value) = "Bitti" O zaman xCell.Tüm satır.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
satırları (belirli hücreler) başka bir sayfaya belirli hücrelere kopyalamak istersem kod ne olur? AMA aynı zamanda bir değere dayalıdır Örnek: renkli ürün resimleri dizisi beyaz blender 2 whiteblender2 siyah meyve sıkacağı 3 blackjuicer3 kırmızı tv 1 redtv1 yeşil demir 4 greeniron4 Dizinin başka bir sayfaya kopyalanmasını istiyorum ama resimler sütunundaki sayı kaç kez kopyalanması gerektiğini söylüyor (bu durumda, blender dizisi 2 satırda kopyalanmalıdır
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, Çok güzel bir kod parçası, çok iyi çalışıyor. Satırları bir sayfa yerine başka bir tabloya taşımak için bu kod nasıl değiştirilir? Çok teşekkürler !
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, kodu kullanmaya çalışıyorum ancak Dim xCell As Range'de bir sözdizimi hatası alıyorum. Lütfen yardım edebilir misin ?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sub Cheezy() Dim xRg As Range Dim xCell As Range Dim I Dim J As Long I = Worksheets("Sheet1").UsedRange.Rows.Count J = Worksheets("Sheet2").UsedRange.Rows.Count If J = 1 Sonra If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 O zaman J = 0 End If Set xRg = Worksheets("Sheet1").Range("C1:C" & I) On Error Resume Sonraki Application.ScreenUpdating = xRg'deki Her xCell İçin False CStr(xCell.Value) = "Done" ise, xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1) xCell. EntireRow.Delete J = J + 1 End If Next If Next Application.ScreenUpdating = True End Sub Satırların sayfa2'ye taşınması için ikinci bir çalışma sayfasını nasıl ekleyebilirim?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Değerime herhangi bir tarih eklemek istersem ne girmeliyim? Yani satır, tarihi yoksa 1. sayfada kalır ve varsa 2. sayfaya mı geçer?
Bu yorum sitedeki moderatör tarafından en aza indirildi
[alıntı] merhaba, bu çok yardımcı oldu. Bunu, veri satırını ikinci sayfaya taşımadan, bunun yerine kopyalatmadan yapmanın bir yolu var mı? Yani veriler her iki sayfada da mı kalacak?Maddie tarafından[/quote] bunu çözen var mı
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu "xCell.EntireRow.Delete" kodunu koddan kaldırın
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu kod satırını silip makroyu yeniden çalıştırdığımda Excel donuyor. Neden ve nasıl düzeltirim?? Verilerin her iki çalışma sayfasında da olmasını ve orijinalinden silinmemesini istiyorum. TIA
Bu yorum sitedeki moderatör tarafından en aza indirildi
bunun bir cevabı var mı? Benimki de donuyor Kopyalamak istiyorum ama satırı silmek istemiyorum
Bu yorum sitedeki moderatör tarafından en aza indirildi
Good Day,
Aşağıdaki VBA kodu, satırları silmek yerine yalnızca kopyalamanıza yardımcı olabilir.

Alt Cheezy()
Aralık olarak Dim xRg
Aralık olarak xCell Dim
Dim kadar uzun
Dim J Uzun
Dim K As Uzun
I = Çalışma Sayfaları("Sayfa1").UsedRange.Rows.Count
J = Çalışma Sayfaları("Sayfa2").UsedRange.Rows.Count
J = 1 ise
Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 ise J = 0
Eğer son
xRg = Çalışma Sayfaları("Sayfa1").Range("C1:C" & I) ayarla
On Error Resume Next
Application.ScreenUpdating = Yanlış
K = 1 ila xRg.Count için
CStr(xRg(K).Value) = "Bitti" ise
xRg(K).EntireRow.Copy Hedef:=Çalışma Sayfaları("Sayfa2").Range("A" & J + 1)
J = J + 1
Eğer son
Sonraki
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, bu konuda bir varyasyon arıyorum. Komut dosyasının sürekli olarak çalışmasına veya o alandaki değer değiştiğinde başarısız olmasına ihtiyacım var. Kodun kendisi çalışıyor ancak bağımsız olarak çalıştırılması gerekiyor. Otomatik olmasını istiyorum. Herhangi biri yardımcı olabilir mi?

Bir kenara, yalnızca aralıktaki belirli hücreleri kopyalamasını istersem, bu nasıl başarılır?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili Rob,

Bu alandaki hücreler değiştiğinde komut dosyasının otomatik olarak çalışmasına ihtiyacınız varsa, aşağıdaki VBA kodu size yardımcı olabilir. Lütfen mevcut sayfa (otomatik olarak hareket ettireceğiniz satırların bulunduğu sayfa) sekmesine sağ tıklayın, ardından içerik menüsünden Kodu Görüntüle'yi seçin. Ardından aşağıdaki VBA betiğini kopyalayıp Kod penceresine yapıştırın.

Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)

Aralık olarak xCell Dim

Dim kadar uzun
On Error Resume Next

Application.ScreenUpdating = Yanlış

xCell'i ayarla = Hedef(1)
xCell.Value = "Bitti" ise
I = Çalışma Sayfaları("Sayfa2").UsedRange.Rows.Count
Eğer ben = 1 O zaman

Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 ise I = 0

Eğer son

xCell.EntireRow.Copy Worksheets("Sheet2").Range("A" & I + 1)

xCell.EntireRow.Delete
Eğer son

Application.ScreenUpdating = True

End Sub


İkinci sorunuz için, tüm satır yerine sadece birkaç hücreyi kopyalamak mı istiyorsunuz? Veya sorunuzun ekran görüntüsünü verir misiniz? Teşekkür ederim!

Saygılarımla, Kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
Kristal,


Yardımınız ihtiyaçtan daha fazlası :)



Buraya başka bir kriteri nasıl ekleyebiliriz, örneğin, Tamamlandı'yı Bitti'nin yanına aktarmak istiyorum:


Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)

Aralık olarak xCell Dim

Dim kadar uzun
On Error Resume Next

Application.ScreenUpdating = Yanlış

xCell'i ayarla = Hedef(1)
xCell.Value = "Bitti" ise
I = Çalışma Sayfaları("Sayfa2").UsedRange.Rows.Count
Eğer ben = 1 O zaman

Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 ise I = 0

Eğer son

xCell.EntireRow.Copy Worksheets("Sheet2").Range("A" & I + 1)

xCell.EntireRow.Delete
Eğer son

Application.ScreenUpdating = True

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba kristal
Bu, web'de bulduğum en faydalı bilgi ve bu makro istediğimi yapıyor. Ancak satırları bir tablodan başka bir tabloya taşıyorum - ve bu makro ile bilgi tablodaki bir sonraki boş satıra değil, tablonun dışındaki ilk boş satıra ait mi? Yardım edebilir misin?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu kodu çalıştırıyorum ve I sütununda görünen bugünün tarihine göre bir satırı taşımaya çalışıyorum - Range("B1:B" & I) öğesini Range(I1:I" & I) olarak değiştirdim. Değiştirdim " Tarih örneğinde Bitti". Ancak, bugünün tarihi gerektiği gibi yalnızca I sütununda değil, satırın herhangi bir yerinde göründüğünde, satır alternatif çalışma sayfasına taşınır. Bunun neden olduğu ve satırı nasıl hareket ettirebileceğim hakkında herhangi bir fikriniz var mı? sadece bugünün tarihi sütun I'de olduğunda, bugünün tarihinin diğer sütunlarda görünüp görünmediğine bakılmaksızın?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili David,

Kod, aralığı ve bugüne kadarki değişken değerini değiştirdikten sonra benim için iyi çalışıyor. Kodunuzdaki tarih biçimi, çalışma sayfasında kullandığınız tarih biçimiyle eşleşmelidir. Yoksa çalışma sayfanızı eklemek sizin için uygun mu?
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba kristal,


Kod ve elektronik tablo tarih biçimlerinin eşleşmesi gerektiğini söylerken ne demek istediğinizi anlamadım - VB uzmanı değilim, daha çok acemi bir seviyedeyim. E-tablomda bugünün tarihini F sütununa satırın giriş tarihi olarak ctrl + : biçiminde giriyorum. "I" sütununa son kullanma tarihini aa/gg/yyyy biçiminde giriyorum. Ancak bu, yeni bir satır girişi yaparken ve F sütununa bugünün tarihini girerken sorunlara neden olur, çünkü girildiği anda satır yeni çalışma sayfasına taşınır. Ayrıca çalışma kitabı her açıldığında çalıştırılacak ek kod görünmez. beni buna zorlamadan kaçmak için. Sizin için çok önemsiz olabilecek şeyler için özür dilerim ama bu sorunları bir türlü anlayamıyorum. Herhangi bir yardım takdir edilecektir.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili David,

Tam olarak yukarıda bahsettiğiniz gibi denedim, ancak benim durumumda sorun dozu görünmüyor. Excel sürümünüzü verebilir misiniz? Bu sorunu çözmeye yardımcı olacak daha fazla bilgiye ihtiyacım var. Seni tekrar rahatsız ettiğim için özür dilerim.

Saygılarımla, Kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
Crystal, bunlar ilgili çalışma sayfaları. Kopyalanan kodda, L sütununda "bugünün tarihine kadar" aradığımı göreceksiniz ve eğer "bu güne kadar" ve bugünün tarihini içeriyorsa, o tarihi içeren satırı yeni bir çalışma sayfasına taşımak istiyorum. Şu anda, satırın herhangi bir yerine bugünün tarihini girdiğimde (örneğin, bugün bir talep yayınlanırsa F sütunu), satırın tamamını otomatik olarak arşivlenen elektronik tabloya taşıyor. Genellikle bugünün tarihini ctrl + : kombinasyonunu kullanarak, genellikle F sütununda girerim.
Ek olarak, çalışma kitabını açtığımda bu hareketin olmasını istiyorum. Şu anda kodu göstermeye gitmem ve ardından F5'e basmam gerekiyor. Bunun nasıl yapılacağına dair herhangi bir tavsiye memnuniyetle karşılanacaktır.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Maalesef makro etkin çalışma kitabım, format desteklenmiyor dediği için yüklenmiyor. Bunlar Excel 2016'da
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili David,

Aşağıdaki VBA kodu, bunu başarmanıza yardımcı olabilir.

Özel Sub Workbook_Open ()
Aralık olarak Dim xRg
Aralık olarak xCell Dim
Dim kadar uzun
Dim J Uzun
I = Çalışma Sayfaları("MEVCUT OASIS FIRSATLARI").UsedRange.Rows.Count
J = Çalışma Sayfaları("ARŞİVLENMİŞ OASIS FIRSATLARI").UsedRange.Rows.Count
J = 1 ise
If Application.WorksheetFunction.CountA(Worksheets("ARŞİVLENMİŞ OASIS OPPORTUNITIES").UsedRange) = 0 O zaman J = 0
Eğer son
xRg = Worksheets("MEVCUT OASIS FIRSATLARI") olarak ayarlayın.Range("L1:L" & I)
On Error Resume Next
Application.ScreenUpdating = Yanlış
xRg'deki Her xCell için
CStr(xCell.Value) = Tarih ise
xCell.EntireRow.Copy Hedef:=Çalışma Sayfaları("ARŞİVLENMİŞ OASIS OPPORTUNITIES").Range("A" & J + 1)
xCell.EntireRow.Delete
J = J + 1
Eğer son
Sonraki
End Sub

Notlar:
1. VBA komut dosyasını ThisWorkbook kod penceresine koymanız gerekir;
2. Çalışma kitabınızın Excel Makro Etkin Çalışma Kitabı olarak kaydedilmesi gerekir.

Yukarıdaki işlemden sonra, çalışma kitabını her açtığınızda, L sütunundaki hücre bugünün tarihine ulaşırsa, satırın tamamı ARŞİVLENDİ çalışma sayfasına taşınacaktır.

Canavar Saygılarımla, Crystal
Bu yorum sitedeki moderatör tarafından en aza indirildi
teşekkürler kristal,
L sütununda bugünün tarihine ulaşılırsa bu harika çalışır. Bugünün tarihini L sütununa dahil etmenin herhangi bir yolu var mı, böylece çalışma kitabını birkaç gün boyunca kontrol etmezsem, otomatik olarak önceki tarihleri ​​de içerecektir. bugünün? Yardımın için çok teşekkürler.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili David,

Üzgünüm, sorunuzu anladığımdan emin değilim. Öyleyse, L sütununda daha önceki tarihler göründüğü sürece tüm satırlar taşınacaktır?
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba kristal,

Çalışma sayfamı birkaç gün açmazsam ve L sütununa girdiğim tarih geçmişse, yani L sütunundaki bir hücredeki tarih 11 Eylül 2017 ise ancak çalışma sayfamı 13 Eylül'e kadar açmazsam, Bugünün tarihine kadar her tarih için kontrol edilecek L sütunundaki tüm girişler gibi, ardından ilgili satırları yeni sayfaya taşıyın. Şu anda nezaketle sağladığınız kodla, yalnızca L sütununda geçerli tarihe sahip satırlar yeni sayfaya taşınıyor ve şu anda manuel olarak yeni sayfaya taşıdığım L sütununda daha eski bir tarihe sahip satırlar geride kalıyor. Yardımın için teşekkürler.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili David,



Anladım. Lütfen aşağıdaki VBA betiğini deneyin. Çalışma kitabını açtığınızda, L sütununda bugünün tarihine kadar olan tüm satırlar yeni belirtilen sayfaya taşınacaktır.



Özel Sub Workbook_Open ()
Aralık olarak Dim xRg
Aralık olarak Dim xRgRtn
Aralık olarak xCell Dim
xLastRow'u İstediğiniz Kadar Uzunlaştırın
Dim kadar uzun
Dim J Uzun
On Error Resume Next
xLastRow = Worksheets("MEVCUT OASIS FIRSATLARI").UsedRange.Rows.Count
xLastRow < 1 ise, Sub'dan Çıkın
J = Çalışma Sayfaları("ARŞİVLENMİŞ OASIS FIRSATLARI").UsedRange.Rows.Count
J = 1 ise
If Application.WorksheetFunction.CountA(Worksheets("ARŞİVLENMİŞ OASIS OPPORTUNITIES").UsedRange) = 0 O zaman J = 0
Eğer son
xRg = Worksheets ("GEÇERLİ OASIS FIRSATLARI") olarak ayarlayın.Range("L1:L" & xLastRow)
I = 2 için xLastRow için
Eğer xRg(I).Value > Date ise Sub Exit
Eğer xRg(I).Value <= Tarih O zaman
xRg(I).EntireRow.Copy Destination:=Worksheets("ARŞİVLENMİŞ OASIS OPPORTUNITIES").Range("A" & J + 1)
xRg(I).EntireRow.Delete
J = J + 1
ben = ben - 1
Eğer son
Sonraki
End Sub

VBA komut dosyasını ThisWorkbook kod penceresine koymanız ve çalışma kitabını Excel Makro Etkin Çalışma Kitabı olarak kaydetmeniz gerekir.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Teşekkürler Crystal, Bu gayet iyi çalışıyor.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Crystal, kodun işe yaradığını söylerken biraz aceleci davrandım. Çalışma kitabımı bugün açtım ve L sütunundaki önceki tarih girişlerini içeren satırlar hala "geçerli vaha fırsatları çalışma sayfasında" ve beklendiği gibi "arşivlenmiş vaha çalışma sayfasına" taşınmadı. Bunun neden böyle olacağına dair bir fikriniz var mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Vurgulanan hücreler, yukarıdaki soruyla ilgili olarak L sütunundadır ve satırı yeni çalışma sayfasına taşımak için ölçütlerdir (bugüne kadar). Umarım bu görüntü yardımcı olur.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu aynı zamanda yukarıdakilerle ilgili VBA penceresinin bir kopyasıdır.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Crystal, kodun işe yaradığını söylerken biraz aceleci davrandım. Çalışma kitabımı bugün açtım ve L sütunundaki önceki tarih girişlerini içeren satırlar hala "geçerli vaha fırsatları çalışma sayfasında" ve beklendiği gibi "arşivlenmiş vaha çalışma sayfasına" taşınmadı. Bunun neden böyle olacağına dair bir fikriniz var mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Kristal,

Çalışma kitabımı yükleyemediğim için satırları ve sütunları burada yeniden oluşturacağım

ABCDEFGHIJKL
# Tip Teminat Talep Değişikliği # Yayınlanma Tarihi Sorular Müşteri Teslimat Yeri Proje Teklifi Son Teslim Tarihi

1 SS SB 1234567 1 09/6/17 Ordu Adı Yok Yer Tahrik Tankı 09/10/17

Aşağıdaki kodu kullanarak, L sütunu bugünün tarihine ulaştığında tüm satırı yeni bir çalışma sayfasına taşımasını istiyorum. Ayrıca, çalışma sayfasını birkaç gün boyunca tamamlamadıysam, aynısını yapmak için L sütununda "bugünün tarihine kadar" aramasını kullanmasını istiyorum. Mümkünse çalışma kitabını açtığımda bunu otomatik olarak yapmasını da isterim. Şu anda satırdaki herhangi bir hücreye, örneğin veri girerken F sütununa bugünün tarihini girersem, satırın tamamı arşiv çalışma sayfasına taşınır. (Excel 2016'yı kullanarak)

[Modül 1 Kodu]

Alt DaveV()

Aralık olarak Dim xRg

Aralık olarak xCell Dim

Dim kadar uzun

Dim J Uzun

I = Çalışma Sayfaları("MEVCUT OASIS FIRSATLARI").UsedRange.Rows.Count

J = Çalışma Sayfaları("ARŞİVLENMİŞ OASIS FIRSATLARI").UsedRange.Rows.Count

J = 1 ise
If Application.WorksheetFunction.CountA(Worksheets("ARŞİVLENMİŞ OASIS OPPORTUNITIES").UsedRange) = 0 O zaman J = 0

Eğer son

xRg = Worksheets("MEVCUT OASIS FIRSATLARI") olarak ayarlayın.Range("L1:L" & I)

On Error Resume Next

Application.ScreenUpdating = Yanlış

xRg'deki Her xCell için

CStr(xCell.Value) = Tarih ise

xCell.EntireRow.Copy Hedef:=Çalışma Sayfaları("ARŞİVLENMİŞ OASIS OPPORTUNITIES").Range("A" & J + 1)
xCell.EntireRow.Delete

J = J + 1
Eğer son

Sonraki
Application.ScreenUpdating = True

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
[Sayfa 1 Kodu]

Özel Alt Çalışma Alanı_Değiştir (ByVal Target As Range)
Aralık olarak xCell Dim
Dim kadar uzun
On Error Resume Next
Application.ScreenUpdating = Yanlış
xCell'i ayarla = Hedef(1)
xCell.Value = Tarih O zaman
I = Çalışma Sayfaları("ARŞİVLENMİŞ OASIS FIRSATLARI").UsedRange.Rows.Count
Eğer ben = 1 O zaman
If Application.WorksheetFunction.CountA(Worksheets("ARŞİVLENDİRİLMİŞ OASIS OPPORTUNITIES").UsedRange) = 0 O zaman I = 0 End If
xCell.EntireRow.Copy Worksheets("ARŞİVLENMİŞ OASIS FIRSATLARI").Range("A" & I + 1)
xCell.EntireRow.Delete
Eğer son
Application.ScreenUpdating = True
End Sub

Umarım yukarıdakiler yardımcı olur ama ben bir VBA insanı değilim, bu yüzden kodun ihtiyacım olanı nasıl yapacağımı anlamıyorum. Yardımınız takdir edilecektir.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Senaryonuzda büyük bir hata var!

7. satırın C sütununda "Bitti" kelimesinin bulunduğunu tespit ettiğinizi söyleyin, bu yüzden onu kopyalayın ve satırı silin.
Satırı sildikten sonra, listedeki bir sonraki satır 9. satır değil 8. satır olacaktır, çünkü 7. satırı bir kez kaldırdığınızda, şimdi 8. satır içeriği 7. satırdadır ve tüm satırlar 1 satır yukarı çıkmıştır. Bu nedenle, kontrol edilecek bir sonraki satırın 8. satır olması gerekiyordu, ancak şimdi daha önce satır #9'da bulunan verileri içeriyor, yani her satırı sildiğinizde, aslında kontrol etmek için bir satırı atlıyorsunuz!!!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili Shau Alon,

Yorumun için teşekkür ederim. Kod, hata düzeltilerek güncellendi. Asistanınız için çok teşekkür ederim.

Saygılarımla, Kristal
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sanırım bu bana oluyor, kodun güncellendiğini söylese de aynı satırı tekrar tekrar kopyalamaya devam ediyor. Bende bu var:

Alt Cheezy()
'Kutools for Excel 2017/8/28 tarafından güncellendi
Aralık olarak Dim xRg
Aralık olarak xCell Dim
Dim kadar uzun
Dim J Uzun
Dim K As Uzun
I = Çalışma Sayfaları("Satın Alma Tahmini").UsedRange.Rows.Count
J = Çalışma Sayfaları("Arşiv Satın Al").UsedRange.Rows.Count
J = 1 ise
If Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 O zaman J = 0
Eğer son
xRg = Worksheets("Satın Alma TAHMİNİ").Range("H3:H" & I) ayarla
On Error Resume Next
Application.ScreenUpdating = Yanlış
K = 1 ila xRg.Count için
CStr(xRg(K).Value) = "Evet" ise
xRg(K).EntireRow.Copy Destination:=Worksheets("Satın Alma Arşivi").Range("A" & J + 1)
xRg(K).Tüm Satır.Sil
CStr(xRg(K).Value) = "Evet" ise
K = K - 1
Eğer son
J = J + 1
Eğer son
Sonraki
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Fred,
Kodu her çalıştırdığınızda, kod belirtilen aralığı arar, bu nedenle hangi satırın zaten kopyalanmış olduğunu söyleyemediğinden aynı satırı tekrar tekrar kopyalar. Aynı satırın tekrar tekrar kopyalanmasını önlemek için, belirtilen hücreye eşleşen bir değer girildiğinde kodun otomatik olarak çalışmasını sağlayabilirsiniz.
"PURCHASE FORCAST" adlı çalışma sayfasında, sayfa sekmesine sağ tıklayın ve Kodu Görüntüle bağlam menüsünden. Ardından aşağıdaki VBA kodunu Sayfa (Kod) penceresinde kopyalayın.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Kutools for Excel 20220830
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("PURCHASE FORCAST").UsedRange.Rows.Count
J = Worksheets("Purchase Archive").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Purchase Archive").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("PURCHASE FORCAST").Range("H3:H" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Yes" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Purchase Archive").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Yes" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Birisi bu işi yapmama yardım edebilir mi? Dosyamla eşleşmesi gereken kısmı değiştirmeye çalıştım ama bu çıkıyor ve ne yapacağımdan emin değilim.
Bu yorum sitedeki moderatör tarafından en aza indirildi
excel dosyasını yüklemeye çalıştığımda dosya desteklenmiyor diyor. Üzgünüm...bununla bugün uğraşıyorum.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Benzer bir görev için yardım istiyorum, ancak biraz farklı. 5 sütunum var, sütun başına yaklaşık 25000, her sütun 1-5 başlığına sahip. Sütun 1'in değeri sıfırdan büyükse VEYA sütun 2 sıfırdan büyükse tüm satırı başka bir sayfaya kopyalamak istiyorum , VEYA 3. sütun sıfırdan küçük, VEYA 4. sütun beşten büyük VEYA 5. sütun ikiden büyük vs. bu mümkün mü?
Bu yorum sitedeki moderatör tarafından en aza indirildi
resim yükleme çalışmıyor... üzgünüm.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,
Lütfen bunun yükle düğmesini kullanın.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Yani amaç, gazlardan herhangi birinin formülde belirleyeceğim bir limitin üzerinde olup olmadığını görmek, yumurtanın tamamı yeni bir sayfaya KOPYALANIYOR.

Her türlü yardımın için çok teşekkür ederim.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Ekli görüntü
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili Michael,
Belki bir Excel eklentisi kullanarak bu sorunu çözebilirsiniz. Burada size Kutools for Excel'in Belirli Hücreleri Seç yardımcı programını öneririm. Bu yardımcı programla, belirli bir sütunun değeri bir sayıdan büyük veya küçükse, belirli bir aralıktaki tüm satırları kolayca seçebilirsiniz. Gerekli tüm satırları seçtikten sonra bunları manuel olarak kopyalayıp yeni bir çalışma sayfasına yapıştırabilirsiniz. Ekli resmin altına bakın.

Aşağıdaki köprüyü takip ederek bu özellik hakkında daha fazla bilgi edinebilirsiniz.
https://www.extendoffice.com/product/kutools-for-excel/excel-select-specific-cells-rows.html
Bu yorum sitedeki moderatör tarafından en aza indirildi
bu formül için teşekkürler, ancak bir sorunum vardı, satırı başka bir sayfaya taşımak istediğimde otomatik olarak olmuyor. bana başka bir formül verebilir misin? bu yüzden hücrenin değerini ne zaman değiştirsem otomatik olarak hareket etti.


Teşekkürler
Bu yorum sitedeki moderatör tarafından en aza indirildi
sevgili canang,
Çalıştır düğmesini manuel olarak tetikleyene kadar kod dozu otomatik olarak gerçekleşmez.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,

Bu makroyu 2 argümanla kurmak istiyorum. O sütunundaki hücrelerin değerine göre dosyamda makronun çalışmasını sağladım. Ancak, satırı taşımadan önce Makronun S Sütununun doldurulup doldurulmadığını (veya <> "") kontrol etmesini istiyorum. . Son olarak, kopyalanan satırların ikinci sayfadaki satırlarla aynı formatta olmasını istiyorum. Bu makroyu tamamen değiştirir mi?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili Hugue'lar,
Seni doğru şekilde anlayıp anlamadığımı bilmiyorum. S sütunundaki hücre doldurulmuşsa ve Sütun O'daki hücre aynı anda belirli bir değeri içeriyorsa, satırı biçimlendirme ile taşıyın mı? Aksi takdirde, hareket etmeyin?
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba kristal,

Evet, demek istediğim tam olarak bu. Aslında verilerim projelerle ilgili. O sütunum projemin durumu ve S projemin bitiş tarihi.
Kullanıcılarımın, bilgiye sahip olan ve eklemesi gereken kişilerin, SADECE durumları "Kapalı" ise ve "Bitiş tarihi" girdiyse bir projeyi "Arşivleyebilmelerini" istiyorum.


Umarım bu bazı şeyleri netleştirmeye yardımcı olur
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili Hugue'lar,
Bu kadar geç cevap verdiğim için özür dilerim. Aşağıdaki VBA kodu, sorunu çözmenize yardımcı olabilir. VBA komut dosyasını uygulamak için lütfen bu makaledeki adımları izleyin.

Alt MoveRowBasedOnCellValue()
Aralık olarak Dim xRgStatus
xRgDate As Aralığı Dim
Dim kadar uzun
Dim J Uzun
Dim K As Uzun
I = Çalışma Sayfaları("Sayfa1").UsedRange.Rows.Count
J = Çalışma Sayfaları("Sayfa2").UsedRange.Rows.Count
J = 1 ise
Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 ise J = 0
Eğer son
Set xRgStatus = Çalışma Sayfaları("Sayfa1").Range("O1:O" & I)
xRgDate = Çalışma Sayfaları("Sayfa1").Range("S1:S" & I) olarak ayarlayın
On Error Resume Next
Application.ScreenUpdating = Yanlış
Application.CutCopyMode = Yanlış
xRgStatus(1).EntireRow.Copy
Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
K = 2 için xRgStatus.Count
CStr(xRgStatus(K).Value) = "Kapalı" ise
Eğer (xRgDate(K).Value <> "") Ve (TypeName(xRgDate(K).Value) = "Date") ise
xRgStatus(K).EntireRow.Copy
Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
J = J + 1
Eğer son
Eğer son
Sonraki
Application.CutCopyMode = Doğru
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
sevgili kristal,

Yardımlarınız için çok teşekkür ederim!

Saygılarımızla,

Hugues
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,


Satırları taşımak yerine nasıl kopyalarım?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,


Bunun birkaç kez gönderildiğini biliyorum ama cevabı bulamıyorum. Malzemeyi yeni sayfaya nasıl kopyalayabilirim ve orijinal sayfadan SİLMEYECEĞİM?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sevgili mike,
Satırları silmek yerine kopyalamak istiyorsanız aşağıdaki VBA kodu size yardımcı olabilir. Yorumun için teşekkür ederim!

Alt Cheezy()
Aralık olarak Dim xRg
Aralık olarak xCell Dim
Dim kadar uzun
Dim J Uzun
Dim K As Uzun
I = Çalışma Sayfaları("Sayfa1").UsedRange.Rows.Count
J = Çalışma Sayfaları("Sayfa2").UsedRange.Rows.Count
J = 1 ise
Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 ise J = 0
Eğer son
xRg = Çalışma Sayfaları("Sayfa1").Range("C1:C" & I) ayarla
On Error Resume Next
Application.ScreenUpdating = Yanlış
K = 1 ila xRg.Count için
CStr(xRg(K).Value) = "Bitti" ise
xRg(K).EntireRow.Copy Hedef:=Çalışma Sayfaları("Sayfa2").Range("A" & J + 1)
J = J + 1
Eğer son
Sonraki
Application.ScreenUpdating = True
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,

Makroları kullanmakta yeniyim, aşağıdaki verileri belirli bir değerden sonra yapıştırmak mümkün mü ve sütun sonuna kadar tekrarlanacak mı?
Bunun gibi:

"Renk"ten sonra "Mavi"yi aktarın

A1 = Mavi
A5= Renkli
A6= ("Mavi"yi buraya aktarın)
ve bunun gibi...
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sayın John,
Bir hücrenin bir sütunda "Renk" içermesi durumunda, ilk hücrenin metnini "Renk" olanın altındaki hücreye kopyalayıp sütunun sonuna kadar bu metni kopyalamayı tekrarlamak mı istiyorsunuz?
Buraya henüz hiç yorum yapılmamış
Daha Çok
Lütfen yorum yazın
Misafir olarak yayınlama
×
Bu gönderiyi değerlendirin:
0   Karakterler
Önerilen Konumlar

Bizi takip et

Telif Hakkı © 2009 - www.extendoffice.com. | Tüm hakları Saklıdır. Tarafından desteklenmektedir ExtendOffice. | | | Site Haritası
Microsoft ve Office logosu, Microsoft Corporation'ın Amerika Birleşik Devletleri ve / veya diğer ülkelerdeki ticari markaları veya tescilli ticari markalarıdır.
Sectigo SSL ile korunmaktadır