• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro Kodlamasında Yardım, Worksheets(1) hk.

Katılım
22 Ağustos 2014
Mesajlar
49
Excel Vers. ve Dili
Ofis 365 Türkçe
Merbaha arkadaşlar,

benim elimde arkadaşıma yazdırdığım bir kodum var.

bu kodun olduğu sayfayı çoğaltıp 5 kopya yapıyorum ancak kodlar aynı kaldığı için kopya sayfalardaki verileri çekmek yerine ilk sayfamdaki veriyi çekiyor sürekli

Kod:
Private Sub CommandButton4_Click()
CommandButton3.Enabled = True
CommandButton4.Enabled = False

Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook

filter = "Text files (*.xlsm),*.xlsm"

caption = "Lütfen Dosya Seçiniz "
customerFilename = "C:\Users\Ofis1\YandexDisk\SEVKIYAT\GUNLUK.xlsm"
Set customerWorkbook = Application.Workbooks.Open(customerFilename)
Application.ScreenUpdating = False
Application.DisplayAlerts = False


For i = 6 To 38

    sat = customerWorkbook.Worksheets(1).Cells(65536, "B").End(xlUp).Row

    If ThisWorkbook.Worksheets(1).Range("E" & i).Value <> 0 Then
        customerWorkbook.Worksheets(1).Range("A" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("A3").Value
        customerWorkbook.Worksheets(1).Range("B" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("B3").Value
        customerWorkbook.Worksheets(1).Range("D" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("D3").Value
        customerWorkbook.Worksheets(1).Range("P" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("A41").Value
        customerWorkbook.Worksheets(1).Range("Q" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("C41").Value
        customerWorkbook.Worksheets(1).Range("J" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("D41").Value
        customerWorkbook.Worksheets(1).Range("K" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("E41").Value
        customerWorkbook.Worksheets(1).Range("L" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("F41").Value
        customerWorkbook.Worksheets(1).Range("M" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("H41").Value
        customerWorkbook.Worksheets(1).Range("S" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("I41").Value
        customerWorkbook.Worksheets(1).Range("T" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("B44").Value
        customerWorkbook.Worksheets(1).Range("N" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("C47").Value
        customerWorkbook.Worksheets(1).Range("R" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("M2").Value
        customerWorkbook.Worksheets(1).Range("O" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("D56").Value
        
        customerWorkbook.Worksheets(1).Range("F" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("E" & i).Value
        customerWorkbook.Worksheets(1).Range("H" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("H" & i).Value
        customerWorkbook.Worksheets(1).Range("I" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("I" & i).Value
        customerWorkbook.Worksheets(1).Range("G" & sat + 1).Value = ThisWorkbook.Worksheets(1).Range("B" & i).Value
    End If

Next i

customerWorkbook.Save
customerWorkbook.Close
MsgBox "Import İşlemi Başarıyla Tamamlandı!" & Alt _


End Sub

kodum bu, butona bastığımda belirli alanlardaki verileri farklı bir sayfaya yazıyor.

arkadaşla görüştüm, Worksheets(1) değeri ile oynarsan olabilir dedi ama debug veriyor.
geçerli sayfalarda bu kodun çalışması için nasıl değiştirebilirim.

şimdiden çok teşekkürler.
 
Arkadaşlar bi el atsanız lütfen. acil yardıma ihtiyacım var.
 
Merhaba

ThisWorkbook.Worksheets (1)

yukarıdaki bölümü aşağıdaki bölümle değiştirin böylece aktif sayfadaki veriler yazdırılacaktır.

ThisWorkbook.Worksheets (ActiveSheet.Name)
 
Geri
Üst