Excel - VBA Kopiowanie z innego pliku w pierwszą wolną komórkę nie działa

Question

Witajcie.

W poniższym kodzie kopiuję dane z pliku nr 1 do pliku nr 2 dane. Chcę aby te dane zostały umieszczone w pierwszą wolną komórkę kolumny A. I teraz mój problem. W kodzie mam Funkcję pierwszypustywiersz i niestety makro robi mi tak, że jeśli w pliku nr 1 mam 1200 wierszy to makro wkleja dane od 1201 mimo, że w 1 komórka w pliku nr 2 jest pusta. Co robię źle?

Function PierwszyPustyWiersz(Optional Kolumna As String = "A")
   PierwszyPustyWiersz = Application.WorksheetFunction.CountA(ActiveSheet.Columns(Kolumna)) + 1
End Function

Sub DopiszDane()
Dim PustyWiersz As Long
 Dim Filt As String
    Dim FilterIndex As Integer
    Dim FileName As Variant
    Dim Title As String
    Dim wiersz As Long

    
'   Lista plików
    Filt = "Pliki arkusza kalkulacyjnego Excel (*.xls),*.xls," & _
           "Pliki arkusza kalkulacyjnego Excel (*.xlsx),*.xlsx," & _
           "Pliki używające przecinka jako separatora (*.csv),*.csv," & _
           "Wszystkie pliki (*.*),*.*"

'  Otwieranie pliku do importowania
    FilterIndex = 1
    Title = "Wybierz plik do zaimportowania"
    FileName = Application.GetOpenFilename( _
        filefilter:=Filt, _
        FilterIndex:=FilterIndex, _
         Title:=Title)

    If FileName = False Then
        MsgBox "Nie wybrano żadnego pliku."
        Exit Sub
    End If
   

    Set CopyFromWorkbook = Workbooks.Open(FileName)
    Set CopyFromWorksheet = CopyFromWorkbook.Worksheets(1)
    
    CopyFromWorksheet.Range("A1:Aa222").Copy
 
    ThisWorkbook.Worksheets(2).Range("A" & PierwszyPustyWiersz("A")).PasteSpecial Paste:=xlPasteValues
    CopyFromWorkbook.Close savechanges:=False
    

End Sub

 

Answer 1

Ok. Poradziłem sobie, ale wyskakuje mi error 1004 czy ktoś jest w stanie mi pomóc?

 

Sub DopiszDane()
Dim PustyWiersz As Long
 Dim Filt As String
    Dim FilterIndex As Integer
    Dim FileName As Variant
    Dim Title As String
    Dim wiersz As Long
 Application.DisplayAlerts = False 'wyłączenie komunikatów schowka
    Application.DisplayClipboardWindow = False 'wyłączenie komunikatów schowka

    
'   Lista plików
    Filt = "Pliki arkusza kalkulacyjnego Excel (*.xls),*.xls," & _
           "Pliki arkusza kalkulacyjnego Excel (*.xlsx),*.xlsx," & _
           "Pliki używające przecinka jako separatora (*.csv),*.csv," & _
           "Wszystkie pliki (*.*),*.*"

'  Otwieranie pliku do importowania
    FilterIndex = 1
    Title = "Wybierz plik do zaimportowania"
    FileName = Application.GetOpenFilename( _
        filefilter:=Filt, _
        FilterIndex:=FilterIndex, _
         Title:=Title)

    If FileName = False Then
        MsgBox "Nie wybrano żadnego pliku."
        Exit Sub
    End If
   

    Set CopyFromWorkbook = Workbooks.Open(FileName)
    Set CopyFromWorksheet = CopyFromWorkbook.Worksheets(1)
    
    CopyFromWorksheet.Range("a2", Range("a2").End(xlDown).End(xlToRight)).Copy
    'CopyFromWorksheet.Range("A" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Copy
    Range("A" & Cells.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
  
    CopyFromWorkbook.Close savechanges:=True
  Application.CutCopyMode = True
 
    

End Sub